#!/usr/local/bin/perl

# $Id: make_tape_barcode,v 1.2 2007/11/11 14:47:17 sr1 Exp sr1 $

# Copyright 2007 Sven Rudolph <sr1@sax.de>
# ( Barcode Writer in Pure PostScript, see below:
#   Copyright (c) 2007 Terry Burton - tez@terryburton.co.uk)

# This program is free software. You may copy or redistribute it under
# the same terms as the Amanda backup software <http://www.amanda.org>.



# TODO
# - paperconf
# - more label and paper types?


# This program creates barcode labels that can be used in tape
# libraries. I use these together with Amanda
# (<http://www.amanda.org>), but they might be useful together with
# other backup software. 


# Tape / Library Compatibility:

# This is intended to be a generic framework. You might need to adapt
# the suffix in labelspec, expecially for older or special libraries
# or tape types. In the long run I might need a more modular way to
# declare labelspec.

# Tested configurations:
# - Quantum (ADIC) i500: lto4, lto-classic
# - Quantum PX502: dlts4, dlts4-classic
# - Overland Neo 2000: dlt-classic


# complex examples:
# - make_tape_barcode -p a4 -l lto4 -i 1-7 -d Set1-1-%02d 1-1-%02d -i 1-7 -d Set1-2-%02d 1-2-%02d -i 1-7 -d Set1-3-%02d 1-3-%02d -i 1-7 -d Set1-4-%02d 1-4-%02d -i 1-6 -d Set1-5-%02d 1-5-%02d





use warnings;
use strict;

my $papertype = 'a4';
my $labeltype;

my %paperspec;
my %labelspec;

my %label;
my %paper;

# 1pt is 1/72in
$paperspec{'a4'} = { xmin => 20, xmax => 575, ymin => 12, ymax => 830 };

$labelspec{'lto4'} = {
    w => 221, h => 48, xshift => 20, yshift => 0,
    bcheight => 0.440, bcwidth => 2.577,
    suffix => "L4", proc => \&print_barcode_descriptionstyle };

$labelspec{'lto4-classic'} = {
    w => 221, h => 48, xshift => 20, yshift => 0,
    bcheight => 0.440, bcwidth => 2.577,
    suffix => "L4", proc => \&print_barcode_classic };

$labelspec{'lto4-dual'} = {
    w => 221, h => 48, xshift => 20, yshift => 0,
    bclargeheight => 0.275, bclargewidth => 2.577,
    bcsmallheight => 0.157, bcsmallwidth => 1.456,
    suffix => "L4", proc => \&print_barcode_dual_lto };

$labelspec{'lto4-dual-large4to6'} = {
    w => 221, h => 48, xshift => 20, yshift => 0,
    bclargeheight => 0.275, bclargewidth => 2.577,
    bcsmallheight => 0.197, bcsmallwidth => 1.456,
    large4to6 => 1,
    suffix => "L4", proc => \&print_barcode_dual_lto };

$labelspec{'dlts4'} = { 
    w => 161, h => 60, xshift => 9, yshift => 5,
    bcheight => 0.511, bcwidth => 2.0,
    suffix => "S4", proc => \&print_barcode_descriptionstyle };

$labelspec{'dlts4-classic'} = { 
    w => 161, h => 60, xshift => 9, yshift => 5,
    bcheight => 0.511, bcwidth => 2.0,
    suffix => "S4", proc => \&print_barcode_classic };

$labelspec{'dlt-classic'} = { 
    w => 161, h => 60, xshift => 9, yshift => 5,
    bcheight => 0.511, bcwidth => 2.0,
    suffix => "", proc => \&print_barcode_classic };

my $markersize = 2;

my $index = 0;

sub usage
{
    my ($fh) = @_;
    
    print $fh <<'EOF';
make_tape_barcode [opts...] ([-d desc] text)...
make_tape_barcode [opts...] (-i intervals [-d templatedesc] templatetext)...

Create the specified barcode labels and emit them as Postscript on stdout.

opts: --demopage     ... print an overview of available label types
      -p papertype   ... specify the paper-type: a4,...
      -l labeltype   ... specify the label type, see demopage

  intervals: interval,interval,...
  interval:  number
  interval:  minnumber-maxnumber

  text:      text to be encoded as barcode, actually this can be numbers
  desc:      longer description text, this could be Amanda's tape name
  template:  a string with one sprintf substitution pattern

example: make_tape_barcode -p a4 -l lto4 -i 1-20 -d Set1-%03d S1-%03d

EOF
}


sub print_markers ($$)
{
    my ($h, $w) = @_;
    my $s = $markersize;

    print "\n" .
	"0.2 setlinewidth " . 
	"newpath 0  0  moveto $s  0   rlineto stroke " .
	"newpath 0  0  moveto 0   $s  rlineto stroke " .

	"newpath 0  $h moveto 0   -$s rlineto stroke " .
	"newpath 0  $h moveto $s  0   rlineto stroke " .

	"newpath $w $h moveto -$s 0   rlineto stroke " .
	"newpath $w $h moveto 0   -$s rlineto stroke " .

	"newpath $w 0  moveto 0   $s  rlineto stroke " .
	"newpath $w 0  moveto -$s 0   rlineto stroke " .
	"\n\n";
}


sub print_barcode_descriptionstyle ($$)
{
    my ($barcodetext, $desctext) = @_;

    my $barcodesuffix = $label{'suffix'};
    my $visiblebarcodetext = "";

    if ( "" ne $desctext)
    {
	$visiblebarcodetext = $barcodetext;
    }
    else
    {
	$desctext = $barcodetext;
    }

    my $descfont = ($visiblebarcodetext eq "") ? 
	"Courier" : "Helvetica";

    print
	"0 0 moveto " .
	"($barcodetext$barcodesuffix) " .
	"  (height=$label{'bcheight'} width=$label{'bcwidth'}) " .
	"  code39 barcode " .
	"/$descfont findfont 12 scalefont setfont " .
	"0 $label{'bcheight'} 72 mul 3 add moveto ($desctext) show " .
	"/Courier findfont 10 scalefont setfont " .
	"$label{'bcwidth'} 72 mul 0.62 mul " .
	"    $label{'bcheight'} 72 mul 4 add moveto " .
	"  ($visiblebarcodetext) show " .
	"/Helvetica findfont 10 scalefont setfont " .
	"$label{'bcwidth'} 72 mul -12 add " .
	"    $label{'bcheight'} 72 mul 4 add moveto " .
	"  ($barcodesuffix) show ";
}

sub print_barcode_dual_lto ($$)
{
    my ($barcodetext, $desctext) = @_;

    my $barcodesuffix = $label{'suffix'};
    my $visiblebarcodetext = "$barcodetext";
    my $fontsize = 12;
    my $smallfontsize = 5;
    
    my ($text1, $text2) = ($barcodetext =~ /^(...)(.*)/);

    print
	"0 28 moveto " .
	"($barcodetext$barcodesuffix) " .
	"  (height=$label{'bclargeheight'} width=$label{'bclargewidth'}) " .
	"  code39 barcode ";

    print
	"0 10 moveto " .
	"($barcodetext$barcodesuffix) " .
	"  (height=$label{'bcsmallheight'} width=$label{'bcsmallwidth'}) " .
	"  code39 barcode ";

    if ($label{'large4to6'})
    {
	$fontsize = 9;
	print 
	    "/Helvetica findfont $fontsize scalefont setfont " .
	    "125 10 moveto ($text1) show " .
	    "/Helvetica-Bold findfont $fontsize 5 add scalefont setfont " .
	    "4 -4 rmoveto ($text2) show " .
	    "/Helvetica findfont $fontsize scalefont setfont " .
	    "175 10 moveto ($barcodesuffix) show ";
    }
    else
    {
	print 
	    "/Helvetica findfont $fontsize scalefont setfont " .
	    "120 10 moveto ($visiblebarcodetext) show " .
	    "/Helvetica findfont $fontsize scalefont setfont " .
	    "170 10 moveto ($barcodesuffix) show ";
    }

    print
	"/Helvetica findfont $smallfontsize scalefont setfont " .
	"45 2 moveto (This edge of label towards hub of tape) show ";
}


sub print_colored_letter_box ($$$)
{
    my ($letter, $width, $height) =  @_;

    my %number_to_color = ( 
			    0 => "1   0.02  0.02", # red
			    1 => "1    1    0   ", # yellow
			    2 => "0.6  1    0.2 ", # light green
			    3 => "0.2  0.7  1   ", # blue
			    4 => "0.7  0.7  0.7 ", # grey
			    5 => "0.9  0.3  0   ", # orange
			    6 => "1    0.2  0.6 ", # pink
			    7 => "0    0.6  0   ", # dark green
			    8 => "1    0.6  0.2 ", # light orange
			    9 => "0.6  0.4  1   ", # purple
			    'default' => "1 1 1", # white
			    );

    my $color = (defined ($number_to_color{$letter})) ?
	$number_to_color{$letter} : $number_to_color{'default'};

    print
	"0 0 moveto " . 
	"0.5 setlinewidth " .
#	"gsave " .
	"  $color setrgbcolor " .
	"  0 0 $width $height rectfill " .
#        "grestore " .
	"  0 0 0  setrgbcolor " .
	"newpath 0 0 $width $height rectstroke " .
	"$width 2 div 3 sub 3 moveto " .
	"/Courier findfont 12 scalefont setfont " .
	"($letter) show\n";
}

sub print_barcode_classic ($$)
{
    my ($barcodetext, $desctext) = @_;

    my $barcodesuffix = $label{'suffix'};
    my $xmin = 0;
    my $xlw = ($label{'w'} - 2 * $label{'xshift'} - 0) / 
	(length($barcodetext) + length($barcodesuffix));

    my $fontsize = 12;
    my $boxsize = $fontsize + 3;

    print
	"0 0 moveto " .
	"($barcodetext$barcodesuffix) " . 
	"  (height=$label{'bcheight'} width=$label{'bcwidth'}) " .
	"  code39 barcode ";

    my $i = 0;


    foreach my $l (split(//, $barcodetext))
    {
	my $xls = $xmin + $i * $xlw;

	print 
	    "gsave " . 
	    "$xls $label{'bcheight'} 72 mul translate ";

	print_colored_letter_box($l, $xlw, $boxsize);

	print 
	    "grestore\n";

	$i++;
    }
    
    print 
	"/Helvetica findfont $fontsize scalefont setfont " .
	"$xlw 7 mul 5 add $label{'bcheight'} 72 mul 3 add moveto " .
	"($barcodesuffix) show ";
}


sub print_barcode ($$)
{
    my ($barcodetext, $desctext) = @_;
    my $visiblebarcodetext;

    %paper = %{$paperspec{$papertype}};
    %label = %{$labelspec{$labeltype}};
    my $barcodesuffix = $label{'suffix'};

    my $w = $label{'w'};
    my $h = $label{'h'};

    my $xnum = int( ($paper{'xmax'}- $paper{'xmin'}) / $label{'w'});
    my $ynum = int( ($paper{'ymax'}- $paper{'ymin'}) / $label{'h'});

    if (($index > 0) && ( $index % ($xnum * $ynum) == 0 ))
    {
	print "showpage ";
	#die "too many labels, only $index labels fit on one page\n";
    }

    my $xindex = $index % $xnum;
    my $yindex = int($index / $xnum) % $ynum;


    my $x = ($paper{'xmax'} + $paper{'xmin'} - $xnum * $label{'w'}) / 2
	+ $label{'w'} * $xindex;
    my $y = ($paper{'ymax'} + $paper{'ymin'} - $ynum * $label{'h'}) / 2
	+ $label{'h'} * ( $ynum - $yindex) - $label{'h'};

    print 
	"gsave " . 
	"$x $y translate ";

    print_markers($h, $w);

    print
	"$label{'xshift'} $label{'yshift'} translate ";

    $label{'proc'}($barcodetext, $desctext, $barcodesuffix);

    print
	"grestore \n\n";

    $index += 1;
}

sub demopage_show_text ($$$)
{
    my ($x, $y, $t) = @_;
    print 
	"/Helvetica findfont 12 scalefont setfont $x $y moveto" .
	"($t) show ";
}

sub print_demopage()
{
    $labeltype = "lto4";
    $index = 0;
    print_barcode("1JAN01", "Set1-Jan-01");
    demopage_show_text(350,800, $labeltype);

    $index = 2;
    print_barcode("DLY012", "Set1-Daily-012");
    demopage_show_text(350,750, $labeltype);

    $labeltype = "lto4-classic";
    $index = 4;
    print_barcode("DLY012", "");
    demopage_show_text(350,700, $labeltype);

    $labeltype = "lto4-dual";
    $index = 6;
    print_barcode("DLY012", "");
    demopage_show_text(350,650, $labeltype);

    $labeltype = "lto4-dual-large4to6";
    $index = 8;
    print_barcode("DLY012", "");
    demopage_show_text(350,600, $labeltype);

    $labeltype = "dlts4";
    $index = 12;
    print_barcode("1JAN01", "Set1-Jan-01");
    demopage_show_text(350,530, $labeltype);

    $index = 15;
    print_barcode("DLY012", "Set1-Daily-012");
    demopage_show_text(350,470, $labeltype);

    $labeltype = "dlts4-classic";
    $index = 18;
    print_barcode("DLY012", "");
    demopage_show_text(350,410, $labeltype);

    $labeltype = "dlt-classic";
    $index = 21;
    print_barcode("DLY012", "");
    demopage_show_text(350,350, $labeltype);


    print "showpage\n";
}


my $do_print_demopage = 0;

while (my $arg = shift(@ARGV))
{
    if ($arg eq "--help")
    {
	usage(*STDOUT) and exit(0);
    }
    elsif ($arg eq "--demopage")
    {
	$do_print_demopage = 1;
    }
    elsif ($arg eq "-p")
    {
	unless ($papertype = shift(@ARGV))
	{
	    usage(*STDERR) and exit(1);
	}
	unless (defined $paperspec{$papertype})
	{
	    die "unknown paper type: $papertype\n";
	}
    }
    elsif ($arg eq "-l")
    {
	unless ($labeltype = shift(@ARGV))
	{
	    usage(*STDERR) and exit(1);
	}
	unless (defined $labelspec{$labeltype})
	{
	    die "unknown label type: $labeltype\n";
	}
    }
    elsif (($arg eq "-d") || ($arg eq "-i"))
    {
	unshift(@ARGV, $arg);
	last;
    }
    elsif ($arg =~ /^-/)
    {
	usage(*STDERR) and exit(1);
    }
    else
    {
	unshift(@ARGV, $arg);
	last;
    }
}

print <DATA>;

my $intervaldesc;
my $desctext = ""; 
my $barcodetext;

if ($do_print_demopage)
{
    print_demopage();
    exit;
}

while (my $arg = shift(@ARGV))
{
    if ($arg eq "-i")
    {
	unless ($intervaldesc = shift(@ARGV))
	{
	    die "missing interval description\n";
	}
	unless ($arg = shift(@ARGV))
	{
	    die "next argument missing\n";
	}
    }

    if ($arg eq "-d")
    {
	unless ($desctext = shift(@ARGV))
	{
	    die "missing description text\n";
	}
	unless ($arg = shift(@ARGV))
	{
	    die "next argument missing\n";
	}
    }

    $barcodetext = $arg;

    if (defined($intervaldesc))
    {
	my @numbers;

	foreach my $interval (split(/,/, $intervaldesc))
	{
	    if ( $interval =~ /^(\d+)-(\d+)$/ )
	    {
		my ($imin, $imax) = ($1, $2);
		
		if ($imin > $imax)
		{
		    die "invalid interval range: $interval\n";
		}

		for ( my $i = $imin; $i <= $imax; $i++)
		{
		    push(@numbers, $i);
		}
	    }
	    elsif ( $interval =~ /^(\d+)$/ )
	    {
		push(@numbers, $interval);
	    }
	    else
	    {
		die "invalid interval specification: $interval\n";
	    }
	}

       
	foreach my $i (@numbers)
	{
	    print_barcode(sprintf($barcodetext, $i), sprintf($desctext, $i));

	}
    }
    else
    {
	print_barcode($barcodetext, $desctext);
    }

    undef $intervaldesc;
    undef $desctext;
}

print "showpage\n";



__END__

%!PS-Adobe-2.0
%%Creator: Terry Burton
%%DocumentPaperSizes: a4
%%EndComments
%%EndProlog

% Barcode Writer in Pure PostScript - Version 2007-07-02
% http://www.terryburton.co.uk/barcodewriter/
%
% Copyright (c) 2007 Terry Burton - tez@terryburton.co.uk
%
% Permission is hereby granted, free of charge, to any
% person obtaining a copy of this software and associated
% documentation files (the "Software"), to deal in the
% Software without restriction, including without
% limitation the rights to use, copy, modify, merge,
% publish, distribute, sublicense, and/or sell copies of
% the Software, and to permit persons to whom the Software
% is furnished to do so, subject to the following
% conditions:
%
% The above copyright notice and this permission notice
% shall be included in all copies or substantial portions
% of the Software.
%
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
% KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO
% THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
% PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
% THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
% DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
% CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
% IN THE SOFTWARE.

% Uncomment this next line to allow these procedure definitions to 
% remain resident within a printer's PostScript virtual machine 
% so that the barcode generation capability persists between jobs.

% serverdict begin 0 exitserver 

% --BEGIN TEMPLATE--

% --BEGIN ENCODER code39--
% --DESC: Code 39
% --EXAM: THIS IS CODE 39
% --EXOP: includetext includecheck includecheckintext
% --RNDR: renlinear
/code39 {

    0 begin                 % Confine variables to local scope

    /options exch def       % We are given an option string
    /useropts options def
    /barcode exch def       % We are given a barcode string

    /includecheck false def  % Enable/disable checkdigit
    /includetext false def
    /includecheckintext false def
    /textfont /Courier def
    /textsize 10 def
    /textpos -7 def
    /height 1 def
    
    % Parse the input options
    options {
        token false eq {exit} if dup length string cvs (=) search
        true eq {cvlit exch pop exch def} {cvlit true def} ifelse
    } loop
    
    /textfont textfont cvlit def
    /textsize textsize cvr def
    /textpos textpos cvr def
    /height height cvr def
    
    % Create an array containing the character mappings
    /encs
    [ (1113313111) (3113111131) (1133111131) (3133111111) (1113311131)
      (3113311111) (1133311111) (1113113131) (3113113111) (1133113111)
      (3111131131) (1131131131) (3131131111) (1111331131) (3111331111)
      (1131331111) (1111133131) (3111133111) (1131133111) (1111333111)
      (3111111331) (1131111331) (3131111311) (1111311331) (3111311311)
      (1131311311) (1111113331) (3111113311) (1131113311) (1111313311)
      (3311111131) (1331111131) (3331111111) (1311311131) (3311311111)
      (1331311111) (1311113131) (3311113111) (1331113111) (1313131111)
      (1313111311) (1311131311) (1113131311) (1311313111)
    ] def

    % Create a string of the available characters
    /barchars (0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%*) def

    /barlen barcode length def  % Length of the code

    includecheck {
        /sbs barlen 10 mul 30 add string def
        /txt barlen 3 add array def
    } {
        /sbs barlen 10 mul 20 add string def
        /txt barlen 2 add array def
    } ifelse

    /checksum 0 def

    % Put the start character
    sbs 0 encs 43 get putinterval
    txt 0 [(*) 0 textpos textfont textsize] put

    0 1 barlen 1 sub {
        /i exch def
        % Lookup the encoding for the each barcode character
        barcode i 1 getinterval barchars exch search
        pop                                  % Discard true leaving pre
        length /indx exch def                % indx is the length of pre
        pop pop                              % Discard seek and post
        /enc encs indx get def               % Get the indxth encoding
        sbs i 10 mul 10 add enc putinterval  % Put encoded digit into sbs
        txt i 1 add [barcode i 1 getinterval i 1 add 16 mul textpos textfont textsize] put
        /checksum checksum indx add def
    } for

    % Put the checksum and end characters
    includecheck {
        /checksum checksum 43 mod def
        sbs barlen 10 mul 10 add encs checksum get putinterval
        includecheckintext {
            txt barlen 1 add [barchars checksum 1 getinterval barlen 1 add 16 mul textpos textfont textsize] put
        } {
            txt barlen 1 add [() barlen 1 add 16 mul textpos textfont textsize] put
        } ifelse
        sbs barlen 10 mul 20 add encs 43 get putinterval
        txt barlen 2 add [(*) barlen 2 add 16 mul textpos textfont textsize] put
    } {
        sbs barlen 10 mul 10 add encs 43 get putinterval
        txt barlen 1 add [(*) barlen 1 add 16 mul textpos textfont textsize] put
    } ifelse
    
    % Return the arguments
    /retval 8 dict def
    retval (ren) (renlinear) put
    retval (sbs) [sbs {48 sub} forall] put
    retval (bhs) [sbs length 1 add 2 idiv {height} repeat] put
    retval (bbs) [sbs length 1 add 2 idiv {0} repeat] put
    includetext {
        retval (txt) txt put
    } if
    retval (opt) useropts put
    retval

    end

} bind def
/code39 load 0 1 dict put
% --END ENCODER code39--


% --BEGIN RENDERER renlinear--
/renlinear {

    0 begin          % Confine variables to local scope

    /args exch def   % We are given some arguments

    % Default options
    /sbs [] def
    /bhs [] def
    /bbs [] def
    /txt [] def
    /barcolor (unset) def
    /textcolor (unset) def
    /bordercolor (unset) def
    /backgroundcolor (unset) def
    /inkspread 0.15 def
    /width 0 def
    /barratio 1 def
    /spaceratio 1 def
    /showborder false def
    /borderleft 10 def
    /borderright 10 def
    /bordertop 1 def
    /borderbottom 1 def
    /borderwidth 0.5 def
    /guardwhitespace false def
    /guardleftpos 0 def
    /guardleftypos 0 def
    /guardrightpos 0 def
    /guardrightypos 0 def
    /guardwidth 6 def
    /guardheight 7 def
    
    % Apply the renderer options
    args {exch cvlit exch def} forall
       
    % Parse the user options   
    opt {
        token false eq {exit} if dup length string cvs (=) search
        true eq {cvlit exch pop exch def} {cvlit true def} ifelse
    } loop

    /barcolor barcolor cvlit def
    /textcolor textcolor cvlit def
    /bordercolor bordercolor cvlit def
    /backgroundcolor backgroundcolor cvlit def
    /inkspread inkspread cvr def
    /width width cvr def
    /barratio barratio cvr def
    /spaceratio spaceratio cvr def
    /borderleft borderleft cvr def
    /borderright borderright cvr def
    /bordertop bordertop cvr def
    /borderbottom borderbottom cvr def
    /borderwidth borderwidth cvr def
    /guardleftpos guardleftpos cvr def
    /guardleftypos guardleftypos cvr def
    /guardrightpos guardrightpos cvr def
    /guardrightypos guardrightypos cvr def
    /guardwidth guardwidth cvr def
    /guardheight guardheight cvr def
    
    % Create bar elements and put them into the bars array
    /bars sbs length 1 add 2 idiv array def
    /x 0.00 def /maxh 0 def
    0 1 sbs length 1 add 2 idiv 2 mul 2 sub {
        /i exch def
        i 2 mod 0 eq {           % i is even
            /d sbs i get barratio mul barratio sub 1 add def  % d=digit*r-r+1 
            /h bhs i 2 idiv get 72 mul def  % Height from bhs
            /c d 2 div x add def            % Centre of the bar = x + d/2
            /y bbs i 2 idiv get 72 mul def  % Baseline from bbs
            /w d inkspread sub def          % bar width = digit - inkspread
            bars i 2 idiv [h c y w] put     % Add the bar entry
            h maxh gt {/maxh h def} if
        } {
            /d sbs i get spaceratio mul spaceratio sub 1 add def  % d=digit*r-r+1 
        } ifelse
        /x x d add def  % x+=d
    } for

    gsave

    currentpoint translate

    % Force symbol to given width
    width 0 ne {
        width 72 mul x div 1 scale
    } if

    % Set RGB or CMYK color depending on length of given hex string
    /setanycolor {
        /anycolor exch def
        anycolor length 6 eq {
            (<      >) dup 1 anycolor putinterval cvx exec {255 div} forall setrgbcolor
        } if
        anycolor length 8 eq {
            (<        >) dup 1 anycolor putinterval cvx exec {255 div} forall setcmykcolor
        } if
    } bind def

    % Display the border and background
    newpath
    borderleft neg borderbottom neg moveto
    x borderleft add borderright add 0 rlineto
    0 maxh borderbottom add bordertop add rlineto
    x borderleft add borderright add neg 0 rlineto
    0 maxh borderbottom add bordertop add neg rlineto    
    closepath
    backgroundcolor (unset) ne { gsave backgroundcolor setanycolor fill grestore } if     
    showborder {
        gsave
        bordercolor (unset) ne { bordercolor setanycolor } if
        borderwidth setlinewidth stroke
        grestore
    } if    
   
    % Display the bars for elements in the bars array
    gsave
    barcolor (unset) ne { barcolor setanycolor } if
    bars {
        {} forall
        newpath setlinewidth moveto 0 exch rlineto stroke
    } forall
    grestore
    
    % Display the text for elements in the text array
    textcolor (unset) ne { textcolor setanycolor } if
    /s 0 def /f () def
    txt {
        {} forall
        2 copy s ne exch f ne or {
            2 copy /s exch def /f exch def            
            exch findfont exch scalefont setfont          
        } {
            pop pop
        } ifelse
        moveto show
    } forall

    % Display the guard elements
    guardwhitespace {
        0.75 setlinewidth
        guardleftpos 0 ne {
            newpath
            guardleftpos neg guardwidth add guardleftypos guardwidth 2 div add moveto
            guardwidth neg guardheight -2 div rlineto
            guardwidth guardheight -2 div rlineto
            stroke            
        } if
        guardrightpos 0 ne {
            newpath
            guardrightpos x add guardwidth sub guardrightypos guardheight 2 div add moveto
            guardwidth guardheight -2 div rlineto
            guardwidth neg guardheight -2 div rlineto
            stroke            
        } if
    } if
    
    grestore
    
    end

} bind def
/renlinear load 0 1 dict put
% --END RENDERER renlinear--

% --BEGIN DISPATCHER--
/barcode {
    0 begin
    dup (ren) get cvx exec 
    end
} bind def
/barcode load 0 1 dict put
% --END DISPATCHER--

% --END TEMPLATE--