#!/usr/bin/env perl

# Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
# This is free software. See the file COPYING.md that came bundled
# with this file.

use strict; use warnings; use warnings FATAL => 'uninitialized';
use Function::Parameters qw(:strict);

# find modules from functional-perl working directory (not installed)
use Cwd 'abs_path';
our ($mydir, $myname); BEGIN {
    my $location= (-l $0) ? abs_path ($0) : $0;
    $location=~ /(.*?)([^\/]+?)_?\z/s or die "?";
    ($mydir, $myname)=($1,$2);
}
use lib "$mydir/../lib";


sub usage {
    print "usage: $myname file.pdf [file2.pdf ..]

   Convert a pdf file to SVG images (by way of `pdf2svg`) and a set of
   html pages embedding them.

   Options:
    --single   create a single html page with all pages (default: one
               page per html file)
    --outdir   default: file path with .pdf suffix stripped
";
    exit 1;
}

use Getopt::Long;
my $verbose=0;
my $opt_single;
my $opt_outdir;
GetOptions("verbose"=> \$verbose,
           "help"=> sub{usage},
           "single-page"=> \$opt_single,
           "outdir=s"=> \$opt_outdir,
          ) or exit 1;

use FP::IOStream qw(xdirectory_paths);
use FP::List qw(list cons);
use FP::Stream qw(Keep);
use Chj::xperlfunc qw(xstat xxsystem_safe xunlink basename dirname);
use FP::Combinators qw(compose_scalar);
use FP::Ops qw(the_method number_cmp regex_match regex_xsubstitute);
use PXML::XHTML ':all';
use PXML::Serialize qw(puthtmlfile);
use FP::Array_sort qw(on);
use Chj::xIOUtil qw(xputfile_utf8);
use Chj::TEST ":all";
use FP::Div qw(min max);
use Chj::singlequote qw(quote_javascript);

sub note {
    print STDERR "$myname: note: ",@_,"\n";
}

fun css_link ($src) {
    LINK ({rel=> "stylesheet",
           href=> $src,
           type=> "text/css"})
}


# svgfile and html paths

our $svgfile_template= 'page-%02d.svg';
our $svgpath_re= qr{(^|.*/)page-(\d+)\.svg$}s;
*svgpath_to_htmlpath= regex_xsubstitute($svgpath_re, sub{"$1/page-$2.html"});
*svgpath_to_pageno= regex_xsubstitute($svgpath_re, sub{$2+0});

our $css_src= "$myname.css";


# CSS contents

my $css_code= '
ul.menu {
  border: 1px solid #000;
  background-color: #eee;
  padding: 5px;
  list-style: none;
  padding-left: 0.5em;
}
li.menu {
  border-right: 1px solid #000;
  list-style: none;
  padding-left: 0.5em;
  padding-right: 0.3em;
  display: inline;
}
li.menu_last {
  list-style: none;
  padding-left: 0.5em;
  padding-right: 0.3em;
  display: inline;
}
';


fun svgpaths ($dir) {
    xdirectory_paths ($dir)
      ->filter (regex_match $svgpath_re)
        ->sort(on *svgpath_to_pageno, *number_cmp)
}


# ------------------------------------------------------------------
# file conversion

fun possibly_symlink ($old,$new) {
    symlink $old, $new
      or note "could not add symlink at '$new': $!";
}

# wrapper just because Perl's core ops can't be passed by *
fun possibly_unlink ($path) {
    unlink $path
}

# convert pdf to svg unless already done
fun possibly_do_pdf2svg ($infile,$outdir) {
    my $outfiles= svgpaths($outdir);
    my $t_in= sub{ xstat($infile)->mtime };
    my $t_oldest= sub {
        Keep($outfiles)->map(compose_scalar the_method("mtime"), *xstat)->min
    };

    if ($outfiles->is_null or &$t_in >= &$t_oldest) {
        $outfiles->for_each(*xunlink);
        xxsystem_safe "pdf2svg", $infile, "$outdir/$svgfile_template", 'all';
        1
    } else {
        0
    }
}


# shorten the navigation to only the pages around the current one plus
# first and last if necessary

fun possibly_shortened ($l,
                        $selected_i,
                        $window_sidelen,
                        $before,
                        $after) {
    my $len= $l->length;

    my $i1= max(0, $selected_i - $window_sidelen);
    my $i2= min($len, $selected_i + $window_sidelen + 1);

    my $remainder= fun ($l, $li) {
        if ($i2 < ($len - 1)) {
            # cut out right part
            $l->take($li + $i2-$i1)->append
              ($after,
               list($l->last));
        } else {
            $l
        }
    };

    if ($i1 > 1) {
        # cut out left part
        cons($l->first,
             $before->append(&$remainder($l->drop($i1), 0)
                             # XX need to turn purearray into a list
                             # or it will be an improper end of the
                             # new list. Ugly.
                             ->list))
    } else {
        &$remainder ($l, $i1)
    }
}

#              0 1 2 3 4 5 6 7
my $l= list(qw(a b c d e f g h))
  unless no_tests;
my $lu= list(undef)
  unless no_tests;

# right

TEST{ possibly_shortened($l, 4, 1, $lu,$lu) }
  list('a', undef, 'd', 'e', 'f', undef, 'h');

TEST{ possibly_shortened($l, 5, 1, $lu,$lu) }
  list('a', undef, 'e', 'f', 'g', 'h');

TEST{ possibly_shortened($l, 6, 1, $lu,$lu) }
  list('a', undef, 'f', 'g', 'h');

TEST{ possibly_shortened($l, 7, 1, $lu,$lu) }
  list('a', undef, 'g', 'h');

TEST{ possibly_shortened($l, 7, 1, $lu,$lu) }
  list('a', undef, 'g', 'h');

# left

TEST{ possibly_shortened($l, 0, 1, $lu,$lu) }
  list('a','b', undef, 'h');

TEST{ possibly_shortened($l, 1, 1, $lu,$lu) }
  list('a','b','c', undef, 'h');

TEST{ possibly_shortened($l, 2, 1, $lu,$lu) }
  list('a','b','c','d', undef, 'h');

TEST{ possibly_shortened($l, 3, 1, $lu,$lu) }
  list('a',undef,'c','d','e', undef, 'h');

TEST{ possibly_shortened($l, 3, 1, $lu,list(0)) }
  list('a',undef,'c','d','e', 0, 'h');


# width

TEST{ possibly_shortened($l, 3, 3, $lu,$lu) }
  $l;
TEST{ possibly_shortened($l, 3, 4, $lu,$lu) }
  $l;
TEST{ possibly_shortened($l, 3, 44, $lu,$lu) }
  $l;
TEST{ possibly_shortened($l, 7, 6, $lu,$lu) }
  $l;
TEST{ possibly_shortened($l, 7, 44, $lu,$lu) }
  $l;

TEST{ possibly_shortened($l, 7, 5, $lu,$lu) }
  list('a', undef, qw(c d e f g h));


fun paging_js_fragment ($keycode, $svgpath) {
    my $htmlpath= svgpath_to_htmlpath($svgpath);
    # HACK: make path correctly locally relative, and avoid having to
    # add parent-taking code to the js:
    $htmlpath=~ s|.*/|/../|s;
    my $quotedpath= quote_javascript($htmlpath);
    "
            case $keycode:
                window.location.pathname= window.location.pathname + $quotedpath;
                break;"
}

fun paging_js ($svgpaths, $maybe_i) {
    if (defined $maybe_i) {
        my $len= $svgpaths->length;
        my $i= $maybe_i;
        my $prev_js= $i == 0 ? ""
          : paging_js_fragment(37, $svgpaths->ref($i-1));
        my $next_js= $i == ($len-1) ? ""
          : paging_js_fragment(39, $svgpaths->ref($i+1));
        SCRIPT({language=> "JavaScript", type=> "text/javascript"},
               '
function actUp(evt) {
    evt = (evt) ? evt : ((event) ? event : null);
    if (evt) {
        switch (evt.keyCode) {'.
               $prev_js.
               $next_js.'
        }
    }
}
document.onkeyup = actUp;
')
    } else {
        undef # XX: add anchor based js in this case?
    }
}

TEST{ paging_js(list(map {"page-$_.svg"} 0..3), 3) }
  SCRIPT(+{language => 'JavaScript', type => 'text/javascript'}, '
function actUp(evt) {
    evt = (evt) ? evt : ((event) ? event : null);
    if (evt) {
        switch (evt.keyCode) {
            case 37:
                window.location.pathname= window.location.pathname + "/../page-2.html";
                break;
        }
    }
}
document.onkeyup = actUp;
');

TEST{ paging_js(list(map {"page-$_.svg"} 0..3), 2) }
  SCRIPT(+{language => 'JavaScript', type => 'text/javascript'}, '
function actUp(evt) {
    evt = (evt) ? evt : ((event) ? event : null);
    if (evt) {
        switch (evt.keyCode) {
            case 37:
                window.location.pathname= window.location.pathname + "/../page-1.html";
                break;
            case 39:
                window.location.pathname= window.location.pathname + "/../page-3.html";
                break;
        }
    }
}
document.onkeyup = actUp;
');

TEST{ paging_js(list(map {"page-$_.svg"} 0..3), 0) }
  SCRIPT(+{language => 'JavaScript', type => 'text/javascript'}, '
function actUp(evt) {
    evt = (evt) ? evt : ((event) ? event : null);
    if (evt) {
        switch (evt.keyCode) {
            case 39:
                window.location.pathname= window.location.pathname + "/../page-1.html";
                break;
        }
    }
}
document.onkeyup = actUp;
');

our $nav_window_sidelen= 10;

my $insert= list(undef);

fun navigation_html ($svgpaths, $for_svgpath, $is_single) {
    my $is_selected= fun ($path) {
        $path eq $for_svgpath
    };

    my $possibly_shortened_svgpaths=
      possibly_shortened($svgpaths,
                         svgpath_to_pageno($for_svgpath),
                         $nav_window_sidelen,
                         $insert,
                         $insert);

    my $ul=
      UL({class=> "menu"},
         $possibly_shortened_svgpaths->map_with_islast
         (fun ($is_last, $maybe_svgpath) {
             if (defined $maybe_svgpath) {
                 my $svgpath= $maybe_svgpath;

                 my $pageno= svgpath_to_pageno($svgpath);

                 my $href= $is_single ? "#p$pageno" :
                   basename svgpath_to_htmlpath ($svgpath);

                 LI({class=> ($is_last ? "menu_last" : "menu")},
                    (&$is_selected($svgpath) ?
                     SPAN({class=> "menu_selected"}, $pageno)
                     : A({href=> $href},
                         $pageno)))
             } else {
                 # never the last
                 LI({class=> "menu"},
                    "...")
             }
         }));

    $is_single ?
      A({name=> "p".svgpath_to_pageno($for_svgpath)},
        $ul)
      : $ul
}


# pure function that returns the actions to be taken (this allows us
# to inspect them before their execution, for debugging or testing):

fun _svgpaths_to_html_actions ($svgpaths, $title, $outdir) {
    # (No need to protect $svgpaths with `Keep` here since it's a
    # purearray because of the sorting)

    # the html fragment for one page from the pdf
    my $page_htmlfragment= fun ($is_last, $for_svgpath) {
        # sub needed to work around destruction of document by
        # weakening done in serializer (ugly, really replace all
        # weakening and Keep stuff with a fixed perl?)
        my $TR_TD_nav=
          sub { TR
                  TD {align=> "center"},
                    navigation_html($svgpaths, $for_svgpath, $opt_single) };
        [
         &$TR_TD_nav,
         TR(TD(IMG +{src=> basename($for_svgpath),
                     width=> "100%"})),
         $opt_single ? ($is_last ? (TR TD HR) : ()) : &$TR_TD_nav
        ]
    };

    my $html= fun ($title, $body, $maybe_for_svgpath) {
        HTML({lang=>'en'}, # XX should not assume 'en' (use HTML5)
             HEAD (TITLE ($title),
                   css_link($css_src),
                   paging_js ($svgpaths, $maybe_for_svgpath)),
             BODY (TABLE({width=> "100%",
                          border=> 0},
                         $body)))
    };

    cons([ *xputfile_utf8, "$outdir/$css_src", $css_code ],

         $opt_single ?
         # all PDF pages in a single HTML page
         list([*possibly_unlink,
               "$outdir/index.html"],
              [
               *puthtmlfile,
               "$outdir/index.html",
               &$html($title,
                      $svgpaths->map_with_islast($page_htmlfragment),
                      undef)
              ])
         :
         # one HTML page per PDF page
         cons([
               *possibly_symlink,
               basename(svgpath_to_htmlpath($svgpaths->first)),
               "$outdir/index.html"
              ],
              $svgpaths->map_with_i
              (fun ($i, $svgpath) {
                  [
                   *puthtmlfile,
                   svgpath_to_htmlpath($svgpath),
                   &$html("$title - page ".svgpath_to_pageno($svgpath),
                          &$page_htmlfragment(0, $svgpath),
                          $i),
                  ]
              })))
}


fun svgpaths_to_html_actions ($infile,$outdir) {
    _svgpaths_to_html_actions(svgpaths($outdir),
                              basename($infile),
                              $outdir)
}

fun pdf_to_html ($infile) {
    my $outdir= $opt_outdir
      // dirname ($infile) . "/" . basename ($infile, ".pdf", 1);

    mkdir $outdir;

    possibly_do_pdf2svg ($infile,$outdir)
      or note "svg files are up to date";

    svgpaths_to_html_actions ($infile,$outdir)->for_each
      (fun ($action) {
          my ($proc, @args)= @$action;
          &$proc(@args)
      });
}



if ($ENV{DEBUG}) {
    require FP::Repl::AutoTrap;
    FP::Repl::repl();
} else {
    perhaps_run_tests __PACKAGE__ or do {
        usage unless @ARGV;
        pdf_to_html ($_) for @ARGV;
    }
}

