#!/usr/bin/perl

use warnings;
use strict;

use Digest::MD5  qw< md5_hex >;
use List::Util   qw< min >;
use MIME::Base64 qw< decode_base64 >;
use Encode       qw<>;
use Getopt::Long;

sub debug($);
sub slurp($);
sub unslurp;

# 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;
    }
  }

  my %images;
  while(<>) {
    s/<<IMAGE(?::([\w-]+))?/
      my $id = $1;

      if($id and $images{$id}) {
        $images{$id};
      } else {
        my $format = (<> =~ m[^[\s%]*(.+)$])[0];
        my $data   = "";
        READ: {
          $data .= (<> =~ m[^[\s%]*(.*)$])[0];
          redo READ unless $data =~ m[=];
        }

        $images{$id || "previous"} = inline_image($format, decode_base64($data));
      }
    /e;

    $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->(slurp($file));
  }

  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

  unslurp do {
    my $tex = $tmpl{size};
    $tex =~ s/\[contents\]/$text/;
    $tex;
  } => 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;
}

sub inline_image {
  my ($format, $data) = @_;

  my %outputformat = (xfig => "pdf", jpeg => "jpg", png => "png", gif => "png", dot => "pdf");
  my $dest = cache_dir . "/" . md5_hex("image-$format-$data") . ".$outputformat{$format}";
  return $dest if -e $dest;

  my %dispatch; %dispatch = (
    xfig => sub {
      # Ok. We have to convert our utf-8 $src to iso-8859-15. Why?
      # Stupid xfig/fig2dev doesn't know utf-8. Actually, it doesn't know
      # iso-8859-15 either (quoting fig2dev(1)):
      #    Text can now include various ISO-character codes above 0x7f, which is use-
      #    ful for language specific characters to be printed directly.  Not all ISO-
      #    characters are implemented.
      # ... no comment
      $data = Encode::encode("iso-8859-15", Encode::decode("utf-8", $data));

      unslurp $data => $dest;
      system(qw/ fig2dev -L pdf -p dummy -f Helvetica /, -m => .7, $dest => $dest) and
        die "Couldn't run fig2dev successfully!\n";
    },
    dot  => sub {
      my $base = ($dest =~ /^(.*)\.pdf$/)[0];
      unslurp $data => "$base.dot";
      system(qw/ dot -Tfig /, "-o" => "$base.fig", "$base.dot") and
        die "Couldn't run dot successfully!\n";

      ($data, $dest) = (slurp("$base.fig"), "$base.pdf");
      $dispatch{xfig}->();
    },
    jpeg => sub { unslurp $data => $dest },
    png  => sub { unslurp $data => $dest },
    gif  => sub {
      unslurp $data => $dest;
      system("convert", $dest => $dest) and die "Couldn't run convert successfully!\n";
    },
  );

  $dispatch{$format}->();
  return $dest;
}

sub slurp($) {
  my $file = shift;

  open my $fh, "<", $file or
    die "Couldn't open \"$file\" for reading: $!\n";

  local $/;
  return scalar <$fh>;
}

sub unslurp {
  my ($data, $file) = @_;

  open my $out, ">", $file or
    die "Couldn't open \"$file\" for writing: $!\n";
  print $out $data or
    die "Couldn't write to \"$file\": $!\n";
  close $out or
    die "Couldn't close \"$file\": $!\n";
}

# 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]
}