#!/usr/bin/perl
#
# Author: John F. Stoffel <jfs@fluent.com> <john@nesc.org>
# Date: 3/3/1998
# Version: 1.0
#
# This code was taken from Jeff Jewett <spider@umd5.umd.edu> and
# beaten with a stick to make it sorta work on an ATL 7100 jukebox.
# Which is also a SUN ETL 7/3500 jukebox as well. I followed the ATL
# spec, but on plain laser paper it's not quite good enough.
#
# Blame me, not Jeff, for what is here.

$boxheight = 59; # 0.82 inches
$boxwidth = 158; # 2.2 inches
$boxseparation = 0;#9; # 0.125 inches
$topmargin = 774; # 0.25 inches from the top
$leftmargin = 18; # 0.25 inches from the left edge

$page = 1;

print "\nEnter name of output file: ";
chop($file = <STDIN>);
print "\n";
open(OUT,"> $file") || die "Can't create the file $file: $!\n";

&code39;

$more = 1;
while ($more) {
  do {
    print "Enter three letter part of label: ";
    chop($let = <STDIN>);
    $let =~ tr/[a-z]/[A-Z]/;
    
    print "Enter starting number: ";
    chop($start = <STDIN>);
    
    print "Enter ending number: ";
    chop($end = <STDIN>);
    
    print "The labels you chose will be in the range of\n\n";
    printf (" %3s%03d - %3s%03d\n\n",$let,$start,$let,$end);
    
    do {
      print "Is this correct? [Y/n] ";
      chop ($ans = <STDIN>);
    } until ($ans =~ m/^$|$y|$n/i);
  } until ($ans =~ m/^$|$y/i);
  
  for ($x = $start; $x <= $end; $x++) {
    $la = sprintf("%3s%03d",$let,$x);
    push @l, $la;
  }
  
  do {
    print "\nEnter more labels? [y/N] ";
    chop ($ans = <STDIN>);
  } until ($ans =~ /^$|^y|^n/i);
  $more-- if ($ans =~ /^$|^n/);
}

print "\nCreating Labels...\n";
    
foreach $label (@l) {
 
  if (!$header_printed) {
    print OUT "%%Page: $page\n";
    # was [5 0 0 15 0 0]
    $width = 4.19;
    $height = 9;
    print OUT "/Code39 findfont [$width 0 0 $height 0 0] makefont ";
    print OUT "3.8 scalefont setfont\n";
    $header_printed++;
  }
  
  $boxx1 = $leftmargin + ($boxwidth + $boxseparation) * $column;
  $boxy1 = $topmargin - ($boxheight + $boxseparation) * $row;
  $boxx2 = $boxx1 + $boxwidth;
  $boxy2 = $boxy1 - $boxheight;
  
  # Position the barcode, should move labelx according to scaling of font.
  $labelx = $boxx1 + 13;
  $labely = $boxy1 - 40;
  
  # Draw outline box
  print OUT "1 setlinewidth\n";
  print OUT "newpath $boxx1 $boxy1 moveto $boxx2 $boxy1 lineto\n";
  print OUT "$boxx2 $boxy2 lineto $boxx1 $boxy2 lineto closepath stroke\n";
  
  # Draw Horizontal Lines
  
  # .03 linewidth
  print OUT "2.5 setlinewidth\n";
  
  # .06 inch from bottom
  print OUT "$boxx1 $boxy2 4 add moveto $boxx2 $boxy2 4 add lineto stroke\n";
  
  # .26 inch from top
  print OUT "$boxx1 $boxy1 19 sub moveto $boxx2 $boxy1 19 sub lineto stroke\n";
  
  # .56 inch from top
  print OUT "$boxx1 $boxy1 41 sub moveto $boxx2 $boxy1 41 sub lineto stroke\n";
  
  # Draw barcode
  print OUT "$labelx $labely moveto (*$label*) show\n";
  
  # Save text label to print at end of page.
  push(@labels, $label);
  
  $row++;
  if ($row > 10) {
    $column++;
    if ($column > 2) {
      &endpage();
      undef (@labels);
      $header_printed = $column = 0;
      $page++;
    }
    $row = 0;
  }
}

if ($row || $column) {
  &endpage();
}

print OUT "%%Trailer\n";
print "done\n";

sub endpage()
{
  local ($row, $column);
  
  print OUT "/Helvetica findfont 14 scalefont setfont\n";
  
  $row = 0;
  foreach $label (@labels) {
    $labelx = $leftmargin + ($boxwidth + $boxseparation) * $column + 20;
    $labely = $topmargin - ($boxheight + $boxseparation) * $row - 55 + 40;
    
    # show the text label part.
    print OUT "$labelx $labely moveto { pop pop ( ) show} ($label) kshow\n";
    $row++;
    if ($row > 10) {
      $column++;
      $row = 0;
    }
  }
  
  print OUT "showpage\n";
}

sub code39 {
  print OUT <<ENDENDEND;
%!PS-Adobe-2.0
%%Title: code39.ps
%%Creator: Willem van Schaik
%%CreationDate: aug 1992
%%DocumentFonts: Helvetica Code39
%%BoundingBox: 0 0 595 842
%%EndComments

/newfont 10 dict def
newfont begin
/FontType 3 def
/FontMatrix [0.01 0 0 0.01 0 0] def
/FontBBox [0 0 100 100] def

/Encoding 256 array def
0 1 255 {Encoding exch /.notdef put} for
Encoding 32 /barSpace put
Encoding 36 /barDollar put
Encoding 37 /barPercent put
Encoding 42 /barAsterisk put
Encoding 43 /barPlus put
Encoding 45 /barHyphen put
Encoding 46 /barPeriod put
Encoding 47 /barSlash put
Encoding 48 /bar0 put
Encoding 49 /bar1 put
Encoding 50 /bar2 put
Encoding 51 /bar3 put
Encoding 52 /bar4 put
Encoding 53 /bar5 put
Encoding 54 /bar6 put
Encoding 55 /bar7 put
Encoding 56 /bar8 put
Encoding 57 /bar9 put
Encoding 65 /barA put
Encoding 66 /barB put
Encoding 67 /barC put
Encoding 68 /barD put
Encoding 69 /barE put
Encoding 70 /barF put
Encoding 71 /barG put
Encoding 72 /barH put
Encoding 73 /barI put
Encoding 74 /barJ put
Encoding 75 /barK put
Encoding 76 /barL put
Encoding 77 /barM put
Encoding 78 /barN put
Encoding 79 /barO put
Encoding 80 /barP put
Encoding 81 /barQ put
Encoding 82 /barR put
Encoding 83 /barS put
Encoding 84 /barT put
Encoding 85 /barU put
Encoding 86 /barV put
Encoding 87 /barW put
Encoding 88 /barX put
Encoding 89 /barY put
Encoding 90 /barZ put

/CharProcs 45 dict def
CharProcs begin
/.notdef {} def
/barSpace {0 7 17 17 7 7 7 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barDollar {0 7 17 7 17 7 17 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barPercent {0 7 7 7 17 7 17 7 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barAsterisk {0 7 17 7 7 17 7 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barPlus {0 7 17 7 7 7 17 7 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barHyphen {0 7 17 7 7 7 7 17 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barPeriod {0 17 17 7 7 7 7 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barSlash {0 7 17 7 17 7 7 7 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar0 {0 7 7 7 17 17 7 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar1 {0 17 7 7 17 7 7 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar2 {0 7 7 17 17 7 7 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar3 {0 17 7 17 17 7 7 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar4 {0 7 7 7 17 17 7 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar5 {0 17 7 7 17 17 7 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar6 {0 7 7 17 17 17 7 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar7 {0 7 7 7 17 7 7 17 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar8 {0 17 7 7 17 7 7 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/bar9 {0 7 7 17 17 7 7 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barA {0 17 7 7 7 7 17 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barB {0 7 7 17 7 7 17 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barC {0 17 7 17 7 7 17 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barD {0 7 7 7 7 17 17 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barE {0 17 7 7 7 17 17 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barF {0 7 7 17 7 17 17 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barG {0 7 7 7 7 7 17 17 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barH {0 17 7 7 7 7 17 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barI {0 7 7 17 7 7 17 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barJ {0 7 7 7 7 17 17 17 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barK {0 17 7 7 7 7 7 7 17 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barL {0 7 7 17 7 7 7 7 17 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barM {0 17 7 17 7 7 7 7 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barN {0 7 7 7 7 17 7 7 17 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barO {0 17 7 7 7 17 7 7 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barP {0 7 7 17 7 17 7 7 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barQ {0 7 7 7 7 7 7 17 17 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barR {0 17 7 7 7 7 7 17 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barS {0 7 7 17 7 7 7 17 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barT {0 7 7 7 7 17 7 17 17 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barU {0 17 17 7 7 7 7 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barV {0 7 17 17 7 7 7 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barW {0 17 17 17 7 7 7 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barX {0 7 17 7 7 17 7 7 7 17 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barY {0 17 17 7 7 17 7 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
/barZ {0 7 17 17 7 17 7 7 7 7 newpath 93 0 moveto 5 {dup 0 65 rlineto
neg 0 rlineto 0 -65 rlineto closepath add neg 0 rmoveto} repeat fill} def
end

/BuildChar
{ 100 0 0 0 93 100 setcachedevice
  exch
  begin
    Encoding exch get
    CharProcs exch get
    end
  exec
} def
end

/Code39 newfont definefont pop

%%EndProlog
ENDENDEND
}