#!/usr/bin/perl
#version 1.0, December 29, 1998.  Author: Brian Fiedler bfiedler@ou.edu
#make a color legend from embedded information in a .eps file
#that was produced by conplot  
#usage:
#clegend myplot.eps
#or:
#clegend myplot.eps %8.1e
#clegend myplot.eps %4.2f
#clegend myplot.eps %3.0u
($infile,$format)=@ARGV;
$infile || die (" no infile specified");
$outfile=$infile;
$outfile=~s/\.eps/\_clegend\.eps/;
open (INFILE,"<$infile") || die ("cannot open $infile for reading");
open (PSOUT,">$outfile") || die ("cannot open $outfile for writing");
while ($line=<INFILE>) {
	last if $line=~m/%begin colortable/;
}
push @colordefs,$line;
while ($line=<INFILE>) {
	last if $line=~m/%end colortable/;
	&doit($line);
}
push @colordefs,$line;
$num=@clev;
&makectab;
###################################################
sub doit{
#	print $line;
	push @colordefs,$line;
	chomp($line);
	$line=~s/^.*%//;
	push @clev,$line;
}
##############################3
sub makectab{
for ($j=0;$j<=$num-1;$j++){
print '$j=',$j,$clev[$j],"\n";
last if $clev[$j]=~m/9\..*e\+30/
#last if $clev[$j]=~m/minus\_inf/
}
$cskip=$j;
&ps_header;
print PSOUT @colordefs;
$clevmin=abs($clev[$j+1]);
$clevmax=abs($clev[$j+1]);
for ($i=$j+1;$i<=$num-1;$i++){
$clevmin=abs($clev[$i]) if abs($clev[$i])<$clevmin;
$clevmax=abs($clev[$i]) if abs($clev[$i])>$clevmax;
}
$lmin=-30;
$lmin=int log($clevmin)/log(10.) if $clevmin > 1.e-30;
$lmax=int log($clevmax)/log(10.);
$form='%8.2e';
if (($lmax-$lmin<2.) and ($lmin) > -3){
sub numerically{$a<=>$b}
@atemp= sort numerically (0,(3-$lmin));
$rdig=pop @atemp; 
@atemp=sort numerically ($rdig+3,$rdig+$lmax+3);
$ldig=pop @atemp;
$form="%${ldig}.${rdig}f";
}
print "$clevmin $clevmax $lmin $lmax $form1\n";
for ($i=$j;$i<=$num-1;$i++){
print $i,$clev[$i+1],"\n";
$def='C'.sprintf('%03d',$i-1);
$x=20;
$y=($i-$cskip)*$del+10;
print PSOUT
"$def N
$x $y M 
0 $del V 
-10 0 V
0 -$del V 
10 0 V P
";
$form=$format if $format;
if ($i > $j) {
$str=sprintf($form,$clev[$i]);
$conco='C002';
$conco='C003' if $clev[$i]<0.;
print PSOUT
" ( $str ) Lshow
$conco N 
$x $y M 
-10 0 V CS
"
}
}
}


#####################################################
sub ps_header{
print "$num $cskip\n";
$del=236/($num-$cskip);
$fonth=.75*$del;
$vshift=-.25*$del;
print PSOUT
"%!PS-Adobe-2.0 EPSF-2.0
%%Creator: perl script 
%%DocumentFonts: Helvetica
%%BoundingBox: 0 0 128 256 
%%EndComments
/M {moveto} bind def
/L {lineto} bind def
/R {rmoveto} bind def
/V {rlineto} bind def
/C {setrgbcolor} bind def
/N {newpath} bind def
/S {stroke} bind def
/L0 {[] 0 setdash} bind def
/L1 {[40 100] 0 setdash} bind def
/CS {stroke} bind def %strokes contour line in color legend 
/CS {} bind def %does NOT stroke contour line in color legend
/P {gsave closepath  fill grestore} bind def
%/AX {stroke} bind def
/AX {} bind def
/Ashow {show} bind def
/Lshow { 0. 0. 0. C  currentpoint AX M
  0 vshift R Ashow } def
/Rshow { currentpoint AX M
  dup stringwidth pop neg vshift R Ashow } def
/Cshow { currentpoint AX M
  dup stringwidth pop -2 div vshift R Ashow } def
/Helvetica $fonth selectfont
/vshift $vshift def
0 setlinewidth
0 0 translate
1.000 1.000 scale
0 setgray
"
}