#!/usr/bin/perl

use warnings;
use strict;

use Digest::MD5 qw< md5_hex >;
use List::Util  qw< min >;
use Getopt::Long;
use IO::All;

sub debug($);

# Read __DATA__ into %tmpl (yielding $tmpl{size} and $tmpl{slide}).
my %tmpl;
{
  my $ptr;
  while(local $_ = <DATA>) {
    if(/^__(\w+)__$/) {
      $ptr = \$tmpl{lc $1};
    } else {
      $$ptr .= $_;
    }
  }
}


GetOptions(
  "cache=s"  => \(my $cache   = ".cache"),
  "latex=s"  => \(my $latex   = "latex"),
  "dvips=s"  => \(my $dvips   = "dvips"),
  "gs=s"     => \(my $gs      = "gs"),
  "output=s" => \(my $output  = "-"),
  "verbose!" => \(my $verbose = 1),
  "help"     => \&usage,
) or usage();
@ARGV > 1 and die "Too arguments given!\n";

sub usage { print STDERR <<EOF; exit }
Usage: $0 [options] [input.latex]

$0 reads LaTeX with special commands and outputs pure LaTeX suitable for
latex or pdflatex. Input and output default to STDIN and STDOUT, respectively.

Available options:
  --output=$output
    Specifies the file the output should go to. Defaults to STDOUT.

  --cache=$cache
    Specifies the cache directory to use.

  --latex=$latex
  --dvips=$dvips
  --gs=$gs
    Sets the paths to latex, dvips, and gs.

  --verbose
  --noverbose
    Sets verboseness.

Options may be abbreviated to uniqueness.
EOF

if($output ne "-") {
  open my $fh, ">", $output or die "Couldn't open \"$output\" for writing: $!\n";
  select $fh;
}

{
  my %cache_accesses;
  mkdir $cache or die "Couldn't mkdir \"$cache\": $!\n" unless -d $cache;

  my $file_id;
  sub set_file_id { $file_id = md5_hex shift }
  sub cache_dir   { $cache }
  sub cache_id    { "$file_id-" . md5_hex join ",", shift, $tmpl{size} }
  set_file_id($ARGV[0] || "-");

  sub register_cache_access { $cache_accesses{shift}++ }
  sub purge_cache           {
    for (glob "$cache/$file_id-*.dim") {
      my $id = (/([0-9a-f\-]+)\.dim/)[0];

      unlink $_ or die "Couldn't unlink \"$_\": $!\n"
        unless $cache_accesses{$id};
    }
  }
}

{
  use constant {
    IN_RAW    => 0,
    IN_TMPL   => 1,
    IN_SLIDES => 2,
  };
  my ($tmpl_ptr, $state, $slides) = (undef, IN_RAW, undef);
  my ($W, $H);

  sub takahashi {
    chomp $slides;
    my @slides = split "\n----\n", $slides;
    $slides = "";

    my $i        = 0;
    for(@slides) {
      $i++;
      my $descr = sprintf "[%3d/%3d]", $i, 0+@slides;

      my @lines = split /\n/, $_;
      my %opts;
      if($lines[0] =~ /^:block/) {
        $opts{block}++;
        shift @lines;
      }

      my $scale = min map {
        debug("$descr $_\n");
        $_ ne "."
          ? scale($_, $W,$H/@lines)
          : ();
      } @lines;

      use constant LINEBREAK => "\\vspace*{1.5em}\n\n";

      my $tex = $opts{block}
        ? "\\scalebox{$scale}{\\vbox{\\flushleft\n" .
          join("\\\\", @lines) .
          "}}" . LINEBREAK
        : join "", map {
            $_ ne "."
              ? "\\scalebox{$scale}{$_}" . LINEBREAK
              : LINEBREAK;
          } @lines;

      my $slide = $tmpl{slide};
      $slide =~ s/\[contents\]/$tex/g;
      print $slide;
    }
  }

  while(<>) {
    $state == IN_RAW and /^=(takahashi\s*)?slidetemplate\s*$/ and
      $state = IN_TMPL, $tmpl{slide} = "", $tmpl_ptr = \$tmpl{slide}, next;
    $state == IN_RAW and /^=(takahashi\s*)?sizetemplate\s*$/ and
      $state = IN_TMPL, $tmpl{size}  = "", $tmpl_ptr = \$tmpl{size},  next;

    $state == IN_RAW and /^=(?:takahashi\s*)?(?:desired_)?dim\s+(\d+)\s+(\d+)$/ and
      ($W, $H) = ($1, $2), next;
    $state == IN_RAW and /^=(?:takahashi\s*)?id\s*(.+)$/ and
      set_file_id($1), next;

    $state == IN_RAW and /^=(takahashi\s*)?slides\s*$/ and
      $state = IN_SLIDES, next;

    $state == IN_SLIDES and /^\s*$/ and takahashi();
    $state != IN_RAW    and /^\s*$/ and $state = IN_RAW, next;

    $state == IN_TMPL   and $$tmpl_ptr .= $_, next;
    $state == IN_SLIDES and $slides    .= $_, next;
    $state == IN_RAW    and print;
  }
}

sub size {
  my $text  = shift;
  my $id    = cache_id $text;

  my $parse_boundingbox = sub {
    my ($x1,$y1, $x2,$y2) = split " ", shift;
    my ($w, $h) = ($x2 - $x1, $y2 - $y1);
    die "Negative width!\n"  if $w < 0;
    die "Negative height!\n" if $h < 0;
    return $w, $h;
  };

  if(-e(my $file = cache_dir . "/$id.dim")) {
    register_cache_access $id;

    return $parse_boundingbox->(io($file)->slurp);
  }

  my $script = <<EOF;
cd "@{[cache_dir]}"           || exit 1
$latex $id.tex    &>/dev/null || exit 1
$dvips -E $id.dvi &>/dev/null || exit 1
{
  $gs -dNOPAUSE -dSAFER -dPARANOIDSAFER -sDEVICE=bbox -- $id.ps 2>&1 1>/dev/null | \
    grep '\%\%HiResBoundingBox:'   || exit 1
} | \
  cut -d' ' -f2,3,4,5 > $id.dim
rm $id.{aux,log,dvi,ps,tex}   || exit 1
EOF

  do {
    my $tex = $tmpl{size};
    $tex =~ s/\[contents\]/$text/;
    $tex;
  } > io(cache_dir . "/$id.tex");

  system $script;

  die "Couldn't determine size!\n" unless -e cache_dir . "/$id.dim";
  return size($text);
}

sub scale {
  my ($text, $W, $H) = @_;
  my ($w, $h)        = size($text);

  die "Zero width!\n"  if $w == 0;
  die "Zero height!\n" if $h == 0;

  return min $W/$w, $H/$h;
}

# Pretty debugging output.
{
  my $fresh;
  sub debug($) {
    my $msg = shift;
    return 1 unless $verbose;

    print STDERR "> " and $fresh++ unless $fresh;
    print STDERR $msg;
    $fresh = 0 if substr($msg, -1) eq "\n";
    1;
  }
}

__DATA__
__SIZE__
\documentclass{article}
\pagestyle{empty}             % Page numbers etc. defeat BoundingBox
                              % calculation

\usepackage{amsmath}
\usepackage{amssymb}
\usepackage{url}

\usepackage{ucs}              % UTF-8
\usepackage[utf8x]{inputenc}

\usepackage[ngerman]{babel}

\usepackage{bookman}          % Nice serif font

\begin{document}
[contents]
\end{document}
__SLIDE__
\frame{\centering\vspace*{0.5em}
[contents]
}