#!/usr/local/bin/perl
# ???PERL START FILE


$cr=chr(13);$lf=chr(10);
$twosides=$contents=$dosfiles=0;
$songlistfile="";


##################
# work arguments #
##################

if (@ARGV==0) {$ARGV[0]="--help";}
foreach $arg (@ARGV) {
    if ($arg eq "--twosides") {$twosides=1;}
    elsif ($arg eq "--contents") {$contents=1;}
    elsif ($arg eq "--dosfiles") {$dosfiles=1;}
    elsif ($arg =~ /^\-/) {
        die ("Usage: $0 [options] listfile\n".
             "    where the given file contains a list of titles,\n".
	     "    such that for each title there is a corresponding\n".
	     "    .txl files are in the current directory.\n".
             "Options:\n".
             "    --twosides  changes page numbering always to be on the outer side\n".
             "    --contents  create contents page\n".
             #"    --dosfiles  use files where lines are ended by CR+LF\n".
	     ""); }
    else {$songlistfile = $arg;}
}

##########################
# create basic song file #
##########################

#if (! open(HEADER,"header.ps")) {
#    if (!(-e "header.ps")) {
#	die ("The header file header.ps does not exist.\n");
#    }
#    if (!(-r "header.ps")) {
#	die ("Access denied for header.ps.\n");
#    }
#    die ("header.ps exists but cannot be opened");
#}
#print <HEADER>;

if (! open(SONGLIST,$songlistfile)) {
    die ("The specified list file '$songlistfile' cannot be opened.");
}
@filelist = <SONGLIST>;
close(SONGLIST);
$page=0;
%songlist = ();
$basefont = "/Helvetica";
$boldfont = $basefont."-Bold";
$setpagesfont = $basefont." 10 selectfont";
$pagenumberingindent = 20;
$leftmargin = 60; #  2cm
$topmargin  = 44; #1.5cm
print ("%!PS-Adobe-3.0\n%%Pages: (atend)\n".
       "%%BoundingBox: 0 0 593 842\n%%EndComments\n".
       "$leftmargin 842 $topmargin sub translate\n".
       "/centerOfThePage 297 $leftmargin sub def  % assume rmargin = lmargin\n\n".
       "/Reencsmalldict 12 dict def\n".
       "/ReEncodeSmall\n".
       "{ Reencsmalldict begin\n".
       "    /NewCodesAndNames exch def /NewFontName exch def /BaseFontName exch def\n".
       "    /BaseFontDict\n".
       "    BaseFontName findfont def\n".
       "    /NewFont BaseFontDict\n".
       "    maxlength dict def\n".
       "    BaseFontDict\n".
       "    { exch dup /FID ne\n".
       "      { dup /Encoding eq\n".
       "        { exch dup length array copy NewFont 3 1 roll put}\n".
       "        { exch NewFont 3 1 roll put} ifelse}\n".
       "      { pop pop } ifelse\n".
       "    } forall\n".
       "    NewFont /FontName NewFontName put NewCodesAndNames aload pop NewCodesAndNames\n".
       "    length 2 idiv\n".
       "    { NewFont /Encoding get 3 1 roll put } repeat\n".
       "    NewFontName NewFont definefont pop\n".
       "  end\n".
       "} def\n".
       "/GermanVec\n".
       "[ 8#344 /adieresis\n".
       "  8#304 /Adieresis\n".
       "  8#366 /odieresis\n".
       "  8#326 /Odieresis\n".
       "  8#374 /udieresis\n".
       "  8#334 /Udieresis\n".
       "  8#337 /germandbls\n".
       "  8#361 /ntilde\n".
       "  8#321 /Ntilde\n".
       "  8#341 /aacute\n".
       "  8#342 /acircumflex\n".
       "  8#340 /agrave\n".
       "  8#301 /Aecute\n".
       "  8#302 /Acircumflex\n".
       "  8#300 /Agrave\n".
       "  8#351 /eacute\n".
       "  8#352 /ecircumflex\n".
       "  8#350 /egrave\n".
       "  8#311 /Eacute\n".
       "  8#312 /Ecircumflex\n".
       "  8#310 /Egrave\n".
       "  8#363 /oacute\n".
       "  8#364 /ocircumflex\n".
       "  8#362 /ograve\n".
       "  8#323 /Oacute\n".
       "  8#324 /Ocircumflex\n".
       "  8#322 /Ograve\n".
       "  8#372 /uacute\n".
       "  8#373 /ucircumflex\n".
       "  8#371 /ugrave\n".
       "] def\n".
       "%%EndProlog\n");

# print contents
if ($contents) 
{
    print ("% %%%%%%%%%%%%%%%%%\n".
	   "% % Contents page %\n".
	   "% %%%%%%%%%%%%%%%%%\n".
	   "%%Page: i 1\ngsave\n".
	   "$basefont $basefont GermanVec ReEncodeSmall\n".
           "/nextline {0 currentpoint exch pop 12 sub moveto} def\n".
           "/printnum {dup stringwidth pop ".(593-2*$leftmargin)." sub neg ".
           "currentpoint exch pop moveto show} def\n");
    print ("(Contents) gsave\n".
	   "$basefont 24 selectfont 0 0 moveto currentpoint 0 exch moveto pop dup stringwidth\n".
	   "pop 2 div centerOfThePage sub neg -24 rmoveto show\n".
	   "0 -50 moveto $basefont 12 selectfont\n");
    @buf = @filelist;
    # @buf =~ s/\.txl($cr|$lf)+//s.
    # $/ = ".txl\n";    # prepare for chomp
    # chomp(@buf);      # cut off the file extension; this leaves the title
    # $/ = "\n";
    $count = 0;
    $lines = 0;
    $initial = "A";
    foreach $filename (@buf) {
	$char = substr($filename,0,1);
	if ($char ne $initial) {
            print ("nextline\n");
            ++$lines;
	    $initial = $char;
	}
        ++$lines;
        if ($lines>=56) { # max 740pt = 58 lines per page
            $lines=0; ++$contents;
            print ("showpage\ngrestore\n\n".
                   "%%Page: ".("i" x $contents)." $contents\n".
		   "$basefont $basefont GermanVec ReEncodeSmall\n".
                   "gsave\n/nextline {0 currentpoint exch pop 12 sub moveto} def\n".
                   "/printnum {dup stringwidth pop ".(593-2*$leftmargin)." sub neg ".
                   "currentpoint exch pop moveto show} def\n".
                   "0 -50 moveto $basefont 12 selectfont\n");
        }
        # $filename =~ s/\.txl.*//s;   # kill file extension
        $filename =~ s/\.txl($cr|$lf)+//s;  #kill file extension
	print ("($filename) show (".++$count.") printnum nextline\n");
    }
    print ("showpage\ngrestore\n\n");
    @buf = ();
    if ($twosides) {
	++$contents;
	print ("%%Page: ".("i" x $contents)." $contents\n".
	       "gsave showpage grestore\n");
    }
}

foreach $filename (@filelist) {
    if (&addSong($filename)) {
	$filename = "";  # on error, 'delete' the song from the file
    }
}

print ("%%Trailer\n".
       "%%Pages: ".($page+$contents)."\n".
       "%%EOF");



################################
# open a file and add contents #
################################

#arg: textline as string
sub printline {
    my ($textline,$base,$chord) = @_;
    print ("moveleft ".
           "0 -".
	   (($textline =~ /</)?
	    2*$base:# + $chord:
	    $base).
	   " rmoveto\n");
    $textpat = "[^<]*"; $chordpat = "[^>]*";
    while ($textline =~ /($textpat)<($chordpat)>/) {
	print ("($1) show ");
	print ("($2) printchords ") if ($2 ne "");
	$textline = substr($textline, length($1)+length($2)+2);
    }
    print ("($textline) show\n");
}

sub getinfo {
    local ($a);
    $a = <SONG>; chop($a);
    return($a);
}

# arg: filename as string
sub addSong {
    my $filename = $_[0];
    $filename =~ s/($cr|$lf)+//.
    my ($title, $author, $intro, $capo, $outro, $graphics);
    my (@chorus, @bridge, @text, %fonts);
    if (! open(SONG,$filename)) {
	print STDERR ("Could not open '$filename'.\n");
        print STDERR ("The contents page will be erroneous!\n") if ($contents);
        return ("1");
    }

    # read data from input file

    $line=<SONG>;
    while ($line ne "") {
	if ($line eq "[Titel]\n") {
	    $title=getinfo(); $line = <SONG>;
	} elsif ($line eq "[Interpret]\n") {
	    $author=getinfo(); $line = <SONG>;
	} elsif ($line eq "[Vorspiel]\n") {
	    $intro=getinfo(); $line = <SONG>;
	} elsif ($line eq "[Kapo]\n") {
	    $capo=getinfo(); $line = <SONG>;
	} elsif ($line eq "[Nachspiel]\n") {
	    $outro=getinfo(); $line = <SONG>;
	} elsif ($line eq "[Graphik]\n") {
	    $graphics=getinfo(); $line = <SONG>;
	} elsif ($line eq "[Refrain]\n") {
	    $line = <SONG>;
	    while ($line ne "" && $line !~ /^\[/) {
	        chop($line);
		@chorus[@chorus+0] = $line;
		$line = <SONG>;
	    }
	} elsif ($line eq "[Bridge]\n") {
	    $line = <SONG>;
	    while ($line ne "" && $line !~ /^\[/) {
	        chop($line);
		@bridge[@bridge+0] = $line;
		$line = <SONG>;
	    }
	} elsif ($line eq "[Text]\n") {
	    $line = <SONG>;
	    while ($line ne "" && $line !~ /^\[/) {
	        chop($line);
		@text[@text+0] = $line;
		$line = <SONG>;
	    }
	} elsif ($line eq "[Fonts]\n") {
	    $fonts{"title","font"}=getinfo();
	    $fonts{"title","size"}=getinfo();
	    $fonts{"title","color"}=getinfo();
	    $fonts{"author","font"}=getinfo();
	    $fonts{"author","size"}=getinfo();
	    $fonts{"author","color"}=getinfo();
	    $fonts{"base","font"}=getinfo();
	    $fonts{"base","size"}=getinfo();
	    $fonts{"base","color"}=getinfo();
	    $fonts{"chord","font"}=getinfo();
	    $fonts{"chord","size"}=getinfo();
	    $fonts{"chord","color"}=getinfo();
	    $line = <SONG>;
	}
	$line = <SONG> unless ($line =~ /^\[/);

    }
    close(SONG);


    # write data into output file

    my ($tlen, $alen) = (length($title), length($author));
    my ($len) = ($tlen > $alen+3) ? $tlen : $alen+3;
    print ("% ".("%" x ($len + 4))." %\n");
    print ("% % $title".(" " x ($len-$tlen+1))."% %\n");
    print ("% % by $author".(" " x ($len-$alen-2))."% %\n") unless ($author eq "");
    print ("% ".("%" x ($len + 4))." %\n");

    # print page header and macros
    ++$page;
    print ("%%Page: $page ".($page+$contents)."\ngsave\n\n");
    print ("$basefont $basefont GermanVec ReEncodeSmall\n".
           "$basefont-Bold $basefont-Bold GermanVec ReEncodeSmall\n");
    print ("/printchords {gsave 0 ".$fonts{"base","size"}." rmoveto setchordfont show grestore} def\n".
	   "/moveleft {currentpoint lefttextbound indent add exch moveto pop} def\n".
	   "/startchorus {\n".
	   "  gsave sethighlightfont moveleft show\n".
	   "  /indent currentpoint /currentypos exch def lefttextbound sub def\n".
	   "  grestore indent lefttextbound add currentypos moveto\n".
	   "} def\n".
	   "/endchorus {/indent 0 def} def\n".
	   "/printreferencetochorus {moveleft 0 -".(2*$fonts{"base","size"})." rmoveto ".
	   "  gsave sethighlightfont moveleft (Refrain) show grestore} def\n");
    print ("/settitlefont    {$boldfont ".$fonts{"title","size"}." selectfont 0 0 0 setrgbcolor} def\n".
	   "/setcomposerfont {$boldfont ".$fonts{"author","size"}." selectfont 0 0 0 setrgbcolor} def\n".
	   "/setbasefont     {$basefont ".$fonts{"base","size"}." selectfont 0 0 0 setrgbcolor} def\n".
	   "/setchordfont    {$basefont ".$fonts{"chord","size"}." selectfont .5 .5 .5 setrgbcolor} def\n".
	   "/sethighlightfont{$boldfont ".$fonts{"base","size"}." selectfont 0 0 0 setrgbcolor} def\n".
	   "/indent 0 def\n");

    
    # print title centered
    print ("($title)\n 0 0 moveto currentpoint 0 exch moveto pop settitlefont dup stringwidth\n".
	   "pop 2 div centerOfThePage sub neg ".$fonts{"title","size"}." neg rmoveto show\n");
    # print author/subtitle/... if applicable
    print ("($author) currentpoint 0 exch moveto pop setcomposerfont\n".
	   "dup stringwidth pop 2 div centerOfThePage sub neg\n".
	   $fonts{"author","size"}." 10 add neg rmoveto show\n") unless ($author eq "");
    # print capo setting
    print ("setbasefont\n".
           "/lefttextbound 0 def\n");
    print ("moveleft (Kapo: $capo) show\n\n") unless ($capo == 0);
    # print introduction/remark/... if applicable
    print ("currentpoint 0 exch moveto pop\n".
	   "0 -100 rmoveto ($intro) show ".
           "0 -".$fonts{"base","size"}." rmoveto\n") unless ($intro eq "");
    # initialize text bounds
    print ("0 -".($fonts{"base","size"}+$fonts{"chord","size"})." rmoveto\n".
	   "/uppertextbound currentpoint exch pop def ".
	   "/lowertextbound uppertextbound def\n");

    foreach $textline (@text) {
	if ($textline eq ">>Refrain") {
            if ($chorus[0] =~ /</) {
                print ("0 -".(2*$fonts{"base","size"})." rmoveto ");
                print ("(Refrain: ) startchorus\n");
                print ("0 ".(2*$fonts{"base","size"})." rmoveto\n");
             } else {
                print ("0 -".$fonts{"base","size"}." rmoveto ");
                print ("(Refrain: ) startchorus\n");
                print ("0 ".$fonts{"base","size"}." rmoveto\n ");
            }
	    foreach $textline2 (@chorus) {
                printline($textline2,$fonts{"base","size"},$fonts{"chord","size"});}
	    print ("endchorus\n");
	} elsif ($textline eq ">>Refrain2") {
            if ($bridge[0] =~ /</) {
                print ("0 -".(2*$fonts{"base","size"})." rmoveto ");
                print ("(Refrain: ) startchorus\n");
                print ("0 ".(2*$fonts{"base","size"})." rmoveto\n");
             } else {
                print ("0 -".$fonts{"base","size"}." rmoveto ");
                print ("(Refrain: ) startchorus\n");
                print ("0 ".$fonts{"base","size"}." rmoveto\n ");
            }
	    foreach $textline2 (@bridge) {
                printline($textline2,$fonts{"base","size"},$fonts{"chord","size"});}
	    print ("endchorus\n");
	} elsif ($textline eq ">>Bridge") {
            if ($bridge[0] =~ /</) {
                print ("0 -".(2*$fonts{"base","size"})." rmoveto ");
                print ("(Bridge: ) startchorus\n");
                print ("0 ".(2*$fonts{"base","size"})." rmoveto\n");
             } else {
                print ("0 -".$fonts{"base","size"}." rmoveto ");
                print ("(Bridge: ) startchorus\n");
                print ("0 ".$fonts{"base","size"}." rmoveto\n ");
            }
	    foreach $textline2 (@bridge) {
                printline($textline2,$fonts{"base","size"},$fonts{"chord","size"});}
	    print ("endchorus\n");
	} elsif ($textline eq "Refrain") {
	    print ("printreferencetochorus\n")
	} elsif ($textline eq ">>neue Spalte") {
	    print ("/lowertextbound currentpoint exch pop 0.7 add def\n".
		   "/lefttextbound centerOfThePage def\n".
		   "lefttextbound uppertextbound moveto\n");
	} else {
	    printline($textline,$fonts{"base","size"},$fonts{"chord","size"});
	}
    }

    # update lower text bound to be the max length of the columns
    print ("currentpoint exch pop dup lowertextbound gt {/lowertextbound exch def} {pop} ifelse\n".
 	   "0 lowertextbound -1 add moveto\n".
	   "($outro) show\n\n");

    # ???Bild anhängen

    # print page numbers
    
    if ($twosides && !($page%2)) {
        print ("$setpagesfont ".($pagenumberingindent-$leftmargin)." -810 44 add moveto\n".
	       "(- $page -) show\n");
    } else {
        print ("$setpagesfont 593 ".($leftmargin+$pagenumberingindent)." sub -810 44 add moveto\n".
	       "(- $page -) dup stringwidth pop neg 0 rmoveto show\n");
    }
    print ("showpage\n".
           "grestore\n\n");
    return 0;
}