#!/usr/bin/env perl6

use v6;
use ABC::Grammar;
use ABC::Actions;
use ABC::ToLilypond;
use File::Temp;

my $paper-size = "letter"; # or switch to "a4" for European paper
my $index-external = True;

# This program always uses the external programs lilypond and qpdf for 
# generating music notation.
# If $index-external is True, then it also uses pdftotext, latex, & dvipdf.

# The index code that follows is incorporated from the Lilypond
# Snippet Repository, http://lsr.di.unimi.it/LSR/Item?id=763

sub write-index-snippet($out) {
    $out.say: q:to/end-snippet/;
        %% defined later, in a closure
        #(define-public (add-index-item! markup-symbol text sorttext) #f)
        #(define-public (index-items) #f)

        #(let ((index-item-list (list)))
           (set! add-index-item!
           (lambda (markup-symbol text sorttext)
             (let ((label (gensym "index")))
               (set! index-item-list
               ;; We insert index items sorted from the beginning on and do
               ;; not sort them later - this saves pretty much computing time
               (insert-alphabetical-sorted! (list label markup-symbol text sorttext)
               index-item-list))
               (make-music 'EventChord
                 'page-marker #t
                 'page-label label
                 'elements (list (make-music 'LabelEvent
                 'page-label label))))))
           (set! index-items (lambda ()
                 index-item-list)))

        #(define (insert-alphabetical-sorted! iitem ilist)
          (if
            (null? ilist) (list iitem)
            (if
              (string-ci<? (cadddr iitem) (cadddr (car ilist))) (cons iitem ilist)
              (cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist)))
            )
          )
        )

        \paper {
          indexTitleMarkup = \markup \column {
            \fontsize #5 \sans \bold \fill-line { \null "Alphabetical Index" \null }
            \hspace #1
          }
          indexItemMarkup = \markup \large \fill-line {
            \fromproperty #'index:text
            \fromproperty #'index:page
          }
          indexSectionMarkup = \markup \column {
            \hspace #1
            \fill-line { \sans \bold \fontsize #3 \fromproperty #'index:text }
            \hspace #1
          }

        }

        #(define-markup-list-command (index layout props) ()
          ( _i "Outputs an alphabetical sorted index, using the paper
          variable @code{indexTitleMarkup} for its title, then the list of
          lines built using the @code{indexItem} music function
          Usage: @code{\\\\markuplist \\\\index}" )
          (cons (interpret-markup layout props
                (ly:output-def-lookup layout 'indexTitleMarkup))
          (space-lines (chain-assoc-get 'baseline-skip props)
                (map (lambda (index-item)
                 (let ((label (car index-item))
                 (index-markup (cadr index-item))
                 (text (caddr index-item)))
                   (interpret-markup
                     layout
                     (cons (list (cons 'index:page
                      (markup #:page-ref label "XXX" "?"))
                     (cons 'index:text text))
                     props)
                     (ly:output-def-lookup layout index-markup))))
               (index-items)))))

        indexItem =
        #(define-music-function (parser location sorttext text) (string? markup?)
           "Add a line to the alphabetical index, using the @code{indexItemMarkup} paper variable markup."
           (add-index-item! 'indexItemMarkup text sorttext))

        indexSection =
        #(define-music-function (parser location sorttext text) (string? markup?)
           "Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
           (add-index-item! 'indexSectionMarkup text sorttext))
        end-snippet
}

sub TuneStreamToTunes($in) {
    my $actions = ABC::Actions.new;
    my $match = ABC::Grammar.parse($in.slurp-rest, :rule<tune_file>, :$actions);
    die "Did not match ABC grammar: last tune understood:\n { $actions.current-tune }" unless $match;
    @( $match.ast );
}

sub start-bookpart($out, $title-string) {
    my ($title, $subtitle) = $title-string.trim.split(":").map(*.trim);
    
    $out.say: "\\bookpart \{";
    $out.say: "\\header \{";
    $out.say: "    title = \"{ sanitize-quotation-marks($title) }\"";
    $out.say: "    subtitle = \"{ sanitize-quotation-marks($subtitle) }\"" if $subtitle;
    $out.say: "\}";

    my $full-title = sanitize-quotation-marks($title-string.trim);
    $out.say: qq{\\tocItem \\markup \\bold "$full-title"};
}

sub read-block(@book) {
    my @block;
    
    while +@book {
        my $line = @book[0];
        if $line ~~ / ^ \h+ \S / {
            @block.push: $line.trim-leading;
            @book.shift;
        } else {
            last;
        }
    }
    
    @block;
}

sub write-lyric($out, @lines) {
    $out.say: "\\noPageBreak";
    $out.say: "\\markup \\fill-line \{";
    $out.say: "    \\column \\column-lines \{";
    for @lines -> $line {
        $out.say: "         \\italic \\line \{ { sanitize-quotation-marks($line) } \}";
    }
    $out.say: "    }";
    $out.say: "}";
}

sub write-text($out, @lines, :$centered) {
    if $centered {
        $out.say: "\\markup \\fill-line \{";
        $out.say: "    \\center-column \\wordwrap-lines \{";
    } else {
        $out.say: "\\markuplist \{";
        $out.say: "    \\wordwrap-lines \{";
    }
    for @lines -> $line {
        $out.say: "         { sanitize-quotation-marks($line) }";
    }
    $out.say: "    }";
    $out.say: "}";
}

sub make-index-sorting-name($full-name) {
    my $name = $full-name;
    $name.=subst(/ ^ "(" /, "");
    $name.=subst(/ ^ "A" \s+ /, "");
    $name.=subst(/ ^ "The" \s+ /, "");
    $name.=subst(/ ^ "La" \s+ /, "");
    $name.=subst(/ ^ "Le" \s+ /, "");
    $name.=subst(/ ^ "É" /, "E");
    $name;
}

sub make-latex-name($full-name) {
    my $name = $full-name;
    $name.=subst(/ "&" /, "\\&", :global);
    $name.=subst(/ "#" /, "\\#", :global);
    $name.=subst(/ "＃" /, "\\#", :global); # Unicode full width number sign
    $name;
}

sub number-pages($pdf-file) {
    my $proc = run "qpdf", "--show-npages", $pdf-file.Str, :out;
    $proc.out.slurp(:close).comb(/ \d+ /).first;
}

sub latex-to-pdf(IO::Path $tex-file) {
    run "latex", '-output-directory=' ~ $tex-file.dirname.Str,
                 '-output-format=pdf',
                 $tex-file.Str;
    # run "dvips", $tex-file.extension("dvi").Str;
    # run "ps2pdf", $tex-file.extension("ps").Str;
    $tex-file.extension("pdf");
}

sub make-blank-page($tempdir) {
    my $blank-tex = IO::Path.new(basename => "blank.tex", dirname => $tempdir);
    my $out = $blank-tex.open(:w);
    $out.say: q:to/END/;
        \documentclass[letterpaper]{article}
        \usepackage[pass]{geometry}
        \begin{document}
            \shipout\hbox{}
        \end{document}
        END

    return latex-to-pdf($blank-tex);
}

sub make-external-toc($tempdir, $pdf-file, @toc-extra-items, $toc-copyright, $toc-tools) {
    # Following assumes one-page TOC, if more something more complicated
    # will be needed.

    my @toc-items = @toc-extra-items;

    my $text = qqx/pdftotext -layout -f 1 -l 1 $pdf-file -/;
    my @unsorted-index;
    for $text.comb(/ ^^ \h* (\V+) \h+ (\d+) $$ /, :match) -> $match {
        @toc-items.push($match[0].Str.trim => ~$match[1]);
    }

    my $toc-tex = IO::Path.new(basename => "toc.tex", dirname => $tempdir);
    my $out = $toc-tex.open(:w);
    $out.say: q:to/END/;
        \documentclass[12pt]{book}
        \renewcommand{\familydefault}{\sfdefault}
        \pagestyle{empty}
        \usepackage[letterpaper, margin=1in, bindingoffset=.5in]{geometry}
        \begin{document}
        \hspace{0pt}
        \vfill
        \center{\bfseries{\huge Contents}}
        \vspace{.5in}
        END

    my $grouping = "";
    for @toc-items -> $toc-item {
        my ($line-grouping, $section) = $toc-item.key.split(/ ':' \s+/);
        if $section {
            if $grouping ne $line-grouping {
                $grouping = $line-grouping;
                $out.say: '\contentsline {chapter}{' ~ $grouping ~ '}{' ~ $toc-item.value ~ '}';
            }
            $out.say: '\contentsline {section}{' ~ $section ~ '}{' ~ $toc-item.value ~ '}';
        } else {
            $out.say: '\contentsline {chapter}{' ~ $toc-item.key ~ '}{' ~ $toc-item.value ~ '}';
        }
    }

    $out.say: q:to/END/;
        \vfill
        END

    if $toc-copyright {
        $out.say: qq:!c:!f:to/END/;
            \\begin{center}
                \\copyright \\ $toc-copyright
            \\end{center}
            END
    }
    
    if $toc-tools {
        $out.say: qq:!c:!f:to/END/;
            \\begin{center}
                $toc-tools

                Typesetting by abc2book, Lilypond, and \\LaTeX
            \\end{center}
            END
    }
    $out.say: q:to/END/;
        \hspace{0pt}
        \end{document}
        END
    $out.close;

    my $temp-file = IO::Path.new(basename => "temp.pdf", dirname => $tempdir);
    run "qpdf", "--empty",
                "--pages",
                    $pdf-file, "2-z",
                "--",
                ~$temp-file;
    $temp-file.move($pdf-file);

    return latex-to-pdf($toc-tex);
}

sub make-external-index($pdf-file, %tunes-hash) {
    my $N = 0;
    for 1..* -> $n {
        my $text = qqx/pdftotext -layout -f $n -l $n $pdf-file -/;
        if $text ~~ / "Alphabetical Index" / {
            $N = $n;
            last;
        }
    }
    
    my $text = qqx/pdftotext -layout -f $N $pdf-file -/;
    my @unsorted-index;
    for $text.comb(/ "ZYXXY" (\d+) "ZYXXY" \s+ (\d+) /, :match) -> $match {
        my $X = $match[0];
        my $page-number = $match[1];
        my @names = %tunes-hash{$X}.header.get("T").map({ sanitize-quotation-marks($_.value) });
        for @names -> $name {
            @unsorted-index.push(make-index-sorting-name($name) => $name => $page-number);
        }
    }
    
    dd $N;
    
    my $out = "index.tex".IO.open(:w);
    $out.say: q:to/END/;
        \documentclass[10pt]{article}
        \usepackage{multicol}
        
        \usepackage[letterpaper, margin=1in, bindingoffset=.5in]{geometry}

        \begin{document}

        \begin{multicols}{2}
        [
        \begin{center}
        { \large \textbf{ Index of Tune Names } }
        \end{center}
        ]

        END
        
    $out.say: "\\setcounter\{page\}\{$N\}";
    
    my $last-first-letter = "";
    for @unsorted-index.sort({ $_.key }) -> $tune {
        my $first-letter = $tune.key.substr(0, 1);
        if $last-first-letter ne $first-letter {
            $out.say: "\\begin\{center\}";
            $out.say: "\{ \\large \\textbf\{ $first-letter \} \}";
            $out.say: "\\end\{center\}";
        }
        $out.say: make-latex-name($tune.value.key) ~ ", " ~ $tune.value.value ~ " \\\\";
        $last-first-letter = $first-letter;
    }
    
    $out.say: q:to/END/;
        \end{multicols}
        \end{document}
        END
    $out.close;

    run "latex", "index.tex";

    # run "dvipdf", "index.dvi";  # this used to work, but update broke dvidpf?
    run "dvips", "index.dvi";
    run "ps2pdf", "index.ps";

    $pdf-file.IO.move("temp.pdf");
    run "qpdf", "--empty", $pdf-file, "--pages", "temp.pdf", "1-{$N-1}", "index.pdf", "--";
}

sub get-tonic-from-first-stem(@events) {
    for @events -> $event {
        if $event.key eq "stem" {
            given $event.value {
                when ABC::Note {
                    return $event.value.basenote.uc;
                }
                when ABC::Stem {
                    return $event.value.notes.map(*.basenote.uc).join('/');
                }
                die "What is this?!";
            }
        }
    }
    
    die "Unable to find stem";
}

sub get-tonic($abc) {
    for $abc.music.kv -> $i, $event {
        if $event.key eq "gracing" && $event.value eq "fine" {
            return get-tonic-from-first-stem($abc.music[$i..*]);
        }
    }
    
    get-tonic-from-first-stem($abc.music.reverse);
}

multi sub MAIN($abc-file, $book-file, :$no-cover?, :$tunes-in-toc?) {
    my $ly-file;
    $ly-file = $book-file ~ ".ly";
    if $book-file ~~ /^(.*) ".book"/ {
        $ly-file = $0 ~ ".ly";
    }
    $*ERR.say: "Reading $abc-file / $book-file, writing $ly-file";

    my $abc-in = open $abc-file, :r or die "Unable to open $abc-file";
    my @tunes = TuneStreamToTunes($abc-in);
    $abc-in.close;

    my %tunes-hash;
    for @tunes -> $tune {
        my $x = $tune.header.get-first-value("X");
        %tunes-hash{$x} = $tune;
    }

    my $book-in = open $book-file, :r or die "Unable to open $book-file";
    my $out = open $ly-file, :w or die "Unable to open $ly-file";

    start-lilypond($out, $paper-size);
    $out.say: '#(set-global-staff-size 17)';

    # Basic structure of this bit borrowed from Ralph Palmer
    # This should keep post-tune text close to its tune,
    # while making most blank space between tunes.
    $out.say: q:to/END/;
        \paper {
          print-all-headers = ##t

          %%%%% paper size %%%%%
          top-margin = 0.5\in

          %%%%% print both sides of paper %%%%%
          two-sided = ##t

          %%%%% margins %%%%%
          inner-margin = 1.06\in     % larger margin for binder holes
          outer-margin = 0.5\in
          
          NonMusicalPaperColumn.page-break-permission = ##f
          ragged-last-bottom = ##t

          %%%%% spacing commands - I had to play with these, esp. stretchability %%%%%

          system-system-spacing = #'((basic-distance . 12)
                                     (minimum-distance . 8)
                                     (padding . 1)
                                     (stretchability . 5))

          markup-markup-spacing = #'((basic-distance . 1)
                                     (padding . 0.5)
                                     (stretchability . 60))

          score-markup-spacing = #'((basic-distance . 2)
                                    (padding . 1)
                                    (stretchability . 1))
                                    
          first-page-number = 0
        }
        END
    
    $out.say: "\\markuplist \\table-of-contents";
    $out.say: "\\pageBreak";

    write-index-snippet($out);
    
    #    my $log = open :w, $*SPEC.devnull;
    my $log = open :w, "abc2ly.log";
    
    my %index-first-letters;
    my $front-cover-file;
    my $title-page-file;
    my $intro-file;
    my $back-cover-file;
    my @toc-extra-items;
    my $toc-copyright;
    my $toc-tools;
    
    my @book = $book-in.lines;
    my $in-part = False;
    while +@book {
        given @book.shift {
            when /^ (\d+) / {
                my $X = ~$0;
                my $abc = %tunes-hash{$X};
                
                my @names = $abc.header.get("T").map({ sanitize-quotation-marks($_.value) });
                $out.say: "\\markup \{ \\vspace #2 \}";
                
                $out.say: qq{\\tocItem \\markup "@names[0]"} if $tunes-in-toc && @names;
                
                for @names -> $name {
                    my $index-sorting-name = make-index-sorting-name($name);
                    my $display-name = $index-external ?? "ZYXXY" ~ $X ~ "ZYXXY" !! $name;
                    $out.say: qq{\\indexItem #"$index-sorting-name" \\markup "$display-name"};
                    %index-first-letters{substr($index-sorting-name, 0, 1)} = 1;
                    last if $index-external; # no need to write more than one name
                }
                
                tune-to-score($abc, $out, $log);
            }
            
            when /^ "Part:" (.*) / {
                $out.say: "}" if $in-part;
                start-bookpart($out, $0.trim);
                $in-part = True;
            }

            when /^ "Lyric:" / {
                write-lyric($out, read-block(@book));
            }

            when /^ "Text:" / {
                write-text($out, read-block(@book));
            }
            
            when /^ "Center:" / {
                write-text($out, read-block(@book), :centered);
            }
            
            when /^ "Substitute:" \s+ (\S+) \s+ (\S+)/ {
                add-substitute(~$0, ~$1);
            }

            when /^ "Substitute:" \s+ (\S+)/ {
                add-substitute(~$0, "");
            }

            when /^ "TitleSkip:" \s+ (\S+)/ {
                add-title-skip(~$0);
            }

            when / ^ "Command:" \s+ (\S.*) $ / {
                $out.say: ~$0;
            }
            
            when / ^ "FrontCover:" \s+ (\S.*) $ / {
                $front-cover-file = ~$0;
            }

            when / ^ "BackCover:" \s+ (\S.*) $ / {
                $back-cover-file = ~$0;
            }

            when / ^ "Intro:" \s+ (\S.*) $ / {
                $intro-file = ~$0;
            }

            when / ^ "TitlePage:" \s+ (\S.*) $ / {
                $title-page-file = ~$0;
            }

            when / ^ "TOC:" \s+ (.+) \s+ (\S+) \s* $ / {
                 @toc-extra-items.push(~$0 => ~$1);
            }

            when / ^ "TOC-Copyright:" \s+ (.*) $ / {
                $toc-copyright = ~$0;
            }

            when / ^ "TOC-Tools:" \s+ (.*) $ / {
                $toc-tools = ~$0;
            }
        }
    }

    $out.say: "}" if $in-part;

    $out.say: qq{\\pageBreak};
    $out.say: qq{\\tocItem \\markup \\bold "Index of Tunes by Name"};
    $out.say: q{        \markuplist \index};
    if !$index-external {
        for %index-first-letters.keys -> $letter {
            $out.say: qq{        \\indexSection #"$letter" \\markup { "$letter" }}
        }
    }

    $out.close;
    $book-in.close;

    qqx/lilypond $ly-file/;

    my $pdf-file = $ly-file.subst(/ ".ly" /, ".pdf");

    my $tempdir = tempdir();
    dd $tempdir;

    my $blank-pdf = make-blank-page($tempdir);

    my $toc-file = make-external-toc($tempdir, $pdf-file, @toc-extra-items, $toc-copyright, $toc-tools);

    if $index-external {
        make-external-index($pdf-file, %tunes-hash);
    }

    sub merge-pdfs(@pdfs, $result-file) {
        my $temp-file = IO::Path.new(basename => "temp.pdf", dirname => $tempdir);
        run "qpdf", "--empty", 
                    "--pages", |@pdfs.map(*.Str), "--",
                    ~$temp-file;
        $temp-file.move($result-file);
    }
    
    # if $intro-file {
    #     my $temp-file = IO::Path.new(basename => "temp.pdf", dirname => $tempdir);
    #     run "qpdf", "--empty",
    #                 "--pages",
    #                     $pdf-file, "1",
    #                     $intro-file,
    #                     $pdf-file, "2-z",
    #                 "--",
    #                 ~$temp-file;
    #     $temp-file.move($pdf-file);
    # }
    
    my @pdfs;
    @pdfs.push($front-cover-file) if $front-cover-file && !$no-cover;
    if $title-page-file {
        @pdfs.push($title-page-file);
        @pdfs.push($blank-pdf) unless number-pages($title-page-file) %% 2;
    }
    @pdfs.push($toc-file);
    @pdfs.push($blank-pdf) unless number-pages($toc-file) %% 2;
    if $intro-file {
        @pdfs.push($intro-file);
        @pdfs.push($blank-pdf) unless number-pages($intro-file) %% 2;
    }
    @pdfs.push($pdf-file);
    @pdfs.push($back-cover-file) if $back-cover-file && !$no-cover;
    merge-pdfs(@pdfs, $pdf-file) if @pdfs > 1;

    $*ERR.say: "Unrecognized gracings: " ~ GetUnrecognizedGracings().keys.join(", ") if GetUnrecognizedGracings();
}