#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: tiff_to_ps_with_label,v 1.1 1998/05/12 18:50:30 ejb Exp $
# $Source: /home/ejb/scripts/RCS/tiff_to_ps_with_label,v $
# $Author: ejb $
#

require 5.002;
use strict;

my $whoami = ($0 =~ m,([^/\\]*)$,) ? $1 : $0;
#my $dirname = ($0 =~ m,(.*)[/\\][^/\\]+$,) ? $1 : ".";

&usage() unless (@ARGV == 2);
my ($file, $label) = @ARGV;

open(PS, "tifftopnm $file | pnmtops |") or
    die "$whoami: can't run pbm commands\n";

my $st_top = 1;
my $st_body = 2;
my $st_done = 3;
my $state = $st_top;
while (<PS>)
{
    if ($state == $st_top)
    {
	if (m/^\%\%EndProlog/)
	{
	    $state = $st_body;
	    print <<EOF;
/fontheight 16 def
/boxheight fontheight 1.2 mul def
/margin fontheight .15 mul def
/label
\{
  gsave
    /Times-Bold findfont fontheight scalefont setfont
    newpath
      % stack: string
      gsave clippath pathbbox grestore
      pop pop
      moveto
      % stack: string
      margin 2 mul dup rmoveto
      dup stringwidth pop
      % stack: string stringwidth
      margin 2 mul add
      dup
      % stack: string boxwidth boxwidth
      0 rlineto
      0 boxheight rlineto
      neg 0 rlineto
      0 boxheight neg rlineto
      closepath
      gsave 1 setgray fill grestore
      % stack: string
      margin dup rmoveto
      show
    stroke
  grestore
\} def
EOF
    ;
	}
    }
    elsif ($state == $st_body)
    {
	if (m/^showpage/)
	{
	    print "($label) label\n";
	}
    }
    print;
}

close(PS);
die "$whoami: command failed\n" unless $? == 0;

sub usage
{
    die "Usage: $whoami file label\n";
}