#!/usr/bin/perl -w

=head1 NAME

B<lalaim> - Produce a LaTeX file with axis labels for an image.

=head1 SYNOPSIS

B<lalaim> [options] [--] left right bot top snhmt image.ext

snhmt is the suggested number of major ticks on the horizontal axis.

Sample options:

  -help|?         brief help message
  --man           full documentation

=head1 DESCRIPTION

Outputs a LaTeX file F<image.tex> with a picture environment for labelling the
axes of F<image.ext>.  The labelled image can then be included in a LaTeX
document with

\input{F<image>}

assuming F<image.ext> and F<image.tex> are in the same directory.

Reasonable values are guessed for the start, end, and spacing of the ticks.
left need not be less than right, and bot need not be less than top.

The optimum number of major ticks is set by the ratio of the maximum
horizontal label length to the image width.

=head1 ARGUMENTS

=over

=item B<-->

ends options.  Necessary if any argument is < 0.

=item B<left>

horizontal coordinate (floating point) of the left image edge.

=item B<right>

horizontal coordinate (floating point) of the right image edge.

=item B<bot>

vertical coordinate (floating point) of the bottom image edge.

=item B<top>

vertical coordinate (floating point) of the top image edge.

=item B<snhmt>

suggested number of horizontal major ticks.

=item B<image.ext>

filename of the image.  ext is taken to be anything after the
final dot.

=head1 OPTIONS

=over

=item B<-H>

suppresses the horizontal numbers, although ticks will still be
drawn.

=item B<-V>

suppresses the vertical numbers, although ticks will still be
drawn.

=item B<--hlab>

Label for the horizontal axis, in LaTeX syntax.

=item B<--vlab>

Label for the vertical axis, in LaTeX syntax.

=item B<--tilt>

Angle by which to rotate the horizontal axis numbers, in degrees.  Nonnegative
numbers work better.  Defaults to 0.

=item B<-c> color

Color to use for ticks.

=item B<-help|?>:

brief help message

=item B<--man>:

full documentation

=back

=cut

# Grrrr...require_order AND -- are required when there are arguments < 0.
use Getopt::Long qw(:config no_ignore_case require_order);

use Pod::Usage;
use POSIX qw(floor ceil);
use strict;

my $nohnums = '';
my $novnums = '';
my $hlab  = '';
my $vlab  = '';
my $tilt  = 0;
my $color   = 'black';
my $help    = 0;
my $man     = 0;
GetOptions('hlab=s' => \$hlab,
	   'vlab=s' => \$vlab,
	   'tilt=s' => \$tilt,
	   'H' => \$nohnums,
	   'V' => \$novnums,
	   'c=s' => \$color,
	   'help|?' => \$help,
	   'man' => \$man) or pod2usage(2);

#print "aft opts: " . join(', ', @ARGV) . "\n";
#print "  hlab = $hlab, vlab = $vlab, tilt = $tilt, color = $color\n";
#print "  |help| = |$help|, |man| = |$man|\n";

pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

my $lft = shift;
my $rgt = shift;
my $bot = shift;
my $top = shift;
my $snhmt = shift;
my $imfn = shift or pod2usage(2);

pod2usage("$0: Too many arguments given.\n")  if (@ARGV > 1);

my $texfn = reverse $imfn;
$texfn =~ s/^[^.]+\./xet./;
$texfn = reverse $texfn;

my ($bbllx, $bblly, $bburx, $bbury) = get_bounding_box($imfn);

open(LTX, "> $texfn") or die "could not > $texfn";
print LTX "\\begin{picture}(0,0)%\n";
my $igfn = reverse $imfn;                # Remove extension to make using
$igfn =~ s/[^.]+\.//;                    # non-eps a bit easier.
$igfn = reverse $igfn;
print LTX "\\includegraphics[width=\\linewidth]{$igfn}%\n";
print LTX "\\end{picture}%\n";
print LTX "\\begingroup\n";

print LTX "\\setlength{\\unitlength}{\\linewidth}%\n";

my $bphlen = abs($bburx - $bbllx);
my $hlen = 1.0;
my $bpvlen = abs($bbury - $bblly);
my $vlen = $bpvlen / $bphlen;

print LTX "\\begin{picture}($hlen,$vlen)(0,0)%\n";
print LTX "\\thicklines%\n";
print LTX "\\put(0,0){\\framebox($hlen,$vlen){}}%\n";

print LTX axis_label('h', $lft, $rgt, $hlab, $hlen, $color, $snhmt,
		     1.0 / (100.0 + sqrt(0.5 * $bpvlen)), $vlen, $nohnums,
		     $tilt);
print LTX axis_label('v', $bot, $top, $vlab, $vlen, $color, $snhmt * $vlen,
		     1.0 / (100.0 + sqrt(0.5 * $bphlen)), $hlen, $novnums,
		     $tilt);

print LTX "\\end{picture}%\n";
print LTX "\\endgroup\n";
print LTX "\\endinput\n";

close(LTX) or die "error closing > $texfn";

# Given the start and end coordinates, and the preferred number of ticks,
# returns the start and end tick values, the major tick spacing, and the number
# of minor ticks between major ticks.
sub reasonableticks {
  my ($sc, $ec, $pn) = @_;

  my $naivespc = abs($ec - $sc) / $pn;
  my $logns = 0.434294482 * log($naivespc);
  my $flogns = floor($logns);
  my $m = $logns - $flogns;

  my $M = 2;
  if($m <= 0.150515){
    $M = 1;
  }
  elsif($m > 0.349485){
    $M = 2.5;
  }
  elsif($m > 0.548455){
#  elsif($m > 0.5){
    $M = 5;
  }
  if($m > 0.8750612634){
    $M = 10;
  }

  my $minorpermajor = 4;
  if($M == 2){
    $minorpermajor = 1;
  }
  elsif($M == 2.5){
    $minorpermajor = 0;
  }

#  print "M = $M\n";

  my $ts = $M * 10 ** $flogns;
  if($ec < $sc){
    $ts = -$ts;
  }

#  print "sc: $sc, ec: $ec, ts: $ts\n";
  return ($ts * ceil($sc / $ts), $ts * floor($ec / $ts), $ts, $minorpermajor);
}

# print "  sc\t  ec\tpn  |    st\t  et\tspacing\tminorpermajor\n";
# print "-" x 70;
# print "\n";

# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        -19.5, -2.3, 7, reasonableticks(-19.5, -2.3, 7));
# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        -19.5, -2.3, 6, reasonableticks(-19.5, -2.3, 6));
# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        -19.5, -2.3, 8, reasonableticks(-19.5, -2.3, 8));
# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        175, 110, 7, reasonableticks(175, 110, 7));
# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        175, 110, 6, reasonableticks(175, 110, 6));
# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        175, 110, 8, reasonableticks(175, 110, 8));
# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        0.0, 4.5, 8, reasonableticks(0.0, 4.5, 8));
# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        0.0, 4.5e-5, 8, reasonableticks(0.0, 4.5e-5, 8));
# printf("%5.3g\t%5.3g\t% 2d  |  %5.3g\t%5.3g\t%5.3g\t% 2d\n",
#        170.0, 174.0, 8, reasonableticks(170.0, 174.0, 8));

sub get_bounding_box {
  my $imfn = shift;

  #print "imfn: $imfn\n";

  my $bbline = "";
  unless($imfn =~ /\.e?ps/i){
    my $bbfn = reverse $imfn;
    $bbfn =~ s/^[^.]+//;
    $bbfn = reverse $bbfn;
    $bbfn .= "bb";
    unless(-f $bbfn){
      system("ebb $imfn");     # ebb doesn't set an error value.
    }
    warn "ebb $imfn did not work" if(!-f $bbfn);
    $imfn = $bbfn;
  }

  $bbline = `grep -m 1 '^%%BoundingBox: ' $imfn`;
  chomp $bbline;

  #print "bbline: $bbline\n";

  my @bb = ();
  if($bbline =~ /^%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/){
    @bb = ($1, $2, $3, $4);
  }
  return @bb;
}

sub round {
  my $num = shift;
  my $floored = floor($num);

  return $num - $floored >= 0.5 ? $floored + 1 : $floored;
}

sub axis_label {
  my ($direction, $sc, $ec, $label, $lgth, $color, $pn, $majticklength,
      $width, $nonums, $tilt) = @_;

  my ($st, $et, $spacing, $minorpermajor) = reasonableticks($sc, $ec, $pn);

  my $minspac = $spacing / ($minorpermajor + 1);
  my $smint   = $minspac * ceil($sc / $minspac);
  my $emint   = $minspac * floor($ec / $minspac);

  my $tstart  = $lgth * ($st - $sc) / ($ec - $sc);
  my $mints   = $lgth * ($smint - $sc) / ($ec - $sc);
  my $tinc    = $lgth * $spacing / ($ec - $sc);
  my $minincr = $tinc / ($minorpermajor + 1);

  my $xstart    = $tstart;
  my $othxstart = $tstart;
  my $minxs     = $mints;
  my $othminxs  = $mints;
  my $ystart    = 0;
  my $othystart = $width;
  my $minys     = 0;
  my $othminys  = $width;
  my $xincr     = $tinc;
  my $yincr     = 0;
  my $xmincr    = $minincr;
  my $ymincr    = 0;
  if($direction eq 'v'){
    $ystart    = $tstart;
    $xstart    = 0;
    $othxstart = $width;
    $othystart = $tstart;
    $minys     = $mints;
    $minxs     = 0;
    $othminxs  = $width;
    $othminys  = $mints;
    $yincr     = $tinc;
    $xincr     = 0;
    $ymincr    = $minincr;
    $xmincr    = 0;
  }

  my $nmt    = round(1 + ($et - $st) / $spacing);
  my $nmint  = round(1 + ($emint - $smint) / $minspac);
  my $output = "{\\color{$color} %\n";

  $output .= "\\thinlines%\n";

  my $tickdir = $direction eq 'h' ? "0,1" : "1,0";
  my $atilt   = $direction eq 'h' ? $tilt : 0;

  my $minticklength = 0.5 * $majticklength;

  $output .= "\\multiput($minxs,$minys)($xmincr,$ymincr){$nmint}{\\line(";
  $output .= "$tickdir){$minticklength}}%\n";       # Bot or left min ticks

  $output .= "\\thicklines%\n";
  $output .= "\\multiput($xstart,$ystart)($xincr,$yincr){$nmt}{\\line(";
  $output .= "$tickdir){$majticklength}}%\n";       # Bot or left maj ticks

  $tickdir = $direction eq 'h' ? "0,-1" : "-1,0";
  my $nlabdir = $direction eq 'h' ? 't' : 'r';

  $output .= "\\multiput($othxstart,$othystart)($xincr,$yincr){$nmt}{\\line(";
  $output .= "$tickdir){$majticklength}}%\n";       # Top or right maj ticks

  $output .= "\\thinlines%\n";
  $output .= "\\multiput($othminxs,$othminys)($xmincr,$ymincr){$nmint}";
  $output .= "{\\line($tickdir){$minticklength}}%\n"; # Top or right min ticks


  $output .= "}%\n";  # End of color and ticks.

  unless($nonums){
    my $lngestnlab = 0;
    for(my $i = 0; $i < $nmt; ++$i){
      $output .= "\\put(";

      my $tpos = $tstart + $i * $tinc;

      if($direction eq 'h'){
	$output .= "$tpos,$ystart";
      } else {
	$output .= "$xstart,$tpos";
      }

      # The rotatebox doesn't do anything for the vertical axis, but it's
      # there.  The \makebox(0,0)[t]{...} makes the [origin=..] option of
      # rotatebox futile and hopefully unnecessary.
      $output .= "){\\makebox(0,0)[$nlabdir]{\\rotatebox{$atilt}{\\strut{}";

      my $nlab = $st + $i * $spacing;
      my $lngnlab = length($nlab);

      if($lngnlab > $lngestnlab){       # Keep track of the widest label.
	$lngestnlab = $lngnlab;
      }

      $output .= $st + $i * $spacing;

      if($direction eq 'v'){
	$output .= " ";          # Puts a space btw the number and the axis.
      }

      $output .= "}}}%\n";
    }

    if($label){
      $output .= "\\put(";         # Axis label.
      if($direction eq 'v'){
	$output .= -0.75 * $lngestnlab * $majticklength;
	$output .= ",";
	$output .= 0.5 * $lgth;   # Center
	$output .= "){\\rotatebox{90}{\\makebox(0,0)[c]{\\strut{}$label}}}%\n";
      } else {
	$output .= 0.5 * $lgth;   # Center
	$output .= ",";
	$output .= -1.5 * $majticklength;
	$output .= "){\\makebox(0,0)[c]{\\strut{}$label}}%\n";
      }
    }
  }

  return $output;
}