#!/usr/bin/perl -w

# {{{  information and version          
#
# Purpose of the script:
#
#    This is a utility for typesetting guitar chords in chordpro format.
#    It uses TeX typesetting system, namely LaTeX2e macro package for TeX.
# 
# Author:               Daniel Polansky           ( dan.polansky@seznam.cz )
# Release:              0.8.0
# Script home page:     http://sweb.cz/dan.polansky/chordpack/
#
# }}}

# {{{  help message                     
$help_message="Usage: chordpack [OPTION]... TASK [FILE]...\n".
    "\n".
    "Operate on songs for guitar found in FILEs. The songs are supposed\n".
    "to be in chordpro format. Operation is determined by TASK, most\n".
    "common is typesetting with TeX. Possible TASKs are tex, html, ascii,\n".
    "nochord, transpose key-or-shift, pro. Options are\n".
    "\n".
    "   -f song-list-file \tUse song-list-file\n".
    "   -l language       \tUse language\n".
    "   -e encoding       \tUse input encoding when typesetting with LaTeX\n".
    "   -b                \tTypeset with minimum barre chords\n".
    "   -c chord-style    \tSet the style of chord typesetting\n".
    "   -s font-sizes     \tSet the font sizes\n".
    "\n".
    "For more detailed information see chordpack-documentation.html.\n";
# }}}
# {{{  support functions                
sub warning {
    if (not $chordpack_introduced) {
	$chordpack_introduced=1;
	printf STDERR "\nChordpack: warning messages:\n\n";
    }
    print STDERR $_[0]; }

sub check_for_the_length {
    my ($line,$file,$maxlength)=@_;

    if (length($line) > $maxlength) {
	if (not exists($files_warned{$file})) {
	    $files_warned{$file}=1;
	    if ($error_explained==0) {
		$error_explained=1;
		warning "Warning >> means too long line ".
		    "(line longer than $maxlength characters).\nFile name where this happened".
			" follows.\n";}
	    warning ">>  $file.\n";}}}

sub insertstring {
    my ($inserted,$source,$position)=@_;

    # Inset string $inserted into the string $source at position
    # $position. If the position is farther than than the length of
    # $source, die.

    if ($position>=length($source)) {
	die "insertstring: position too far.\n"; }

    return substr($source,0,$position).$inserted.substr($source,$position,length($source)-$position);}

# }}}

# {{{  global variables and constants   
$chordpack_introduced=0;
$error_explained=0;
$carriage_return_warned=0;

@tex_font_size = ( "\\tiny" , "\\scriptsize" , "\\footnotesize" ,
		   "\\small" , "\\normalsize" , "\\large", "\\Large" ,
		   "\\LARGE", "\\huge" , "\\Huge" );

# }}}
# {{{  global options                   
use Getopt::Std;
getopts('bf:c:l:s:e:');

sub option_process {
    my ($option,$default,$option_letter) = @_;
    $from_options{$option}=0;
    eval ("\$$option=\"$default\"");
    if (eval "defined(\$opt_$option_letter)") {
	$from_options{$option}=1;
	eval ("\$$option=\$opt_$option_letter"); }}


option_process("language","","l"); 
# the only supported languages are Czech and German. The default language is English.

option_process("inputenc","","e");
# for LaTeX typesetting

option_process("chord_style","m","c");
# chordstyle string contains mi,m or - and also h if h is required


option_process("font_sizes",3,"s");
# currently available values are 0,1,2,3

option_process("title_style","","");

option_process("columns",2,"");

$nobarre=0; $nobarre=1 if defined($opt_b) and $opt_b==1;
# This option cannot be set using {} command

# option -f is processed in tex task

$ignore_tablature=0;
$ignore_tablature=1 if $nobarre;


# ------------------------------------

# {{{ finalize_options
sub finalize_options {

    $language=lc($language);

    $H_chord=0;
    $chord_style_string=$chord_style;
    for ($chord_style_string) {
	$H_chord=1         if (/h/);
	$chord_style="-"   if (/jazz/ or /-/);
	$chord_style="mi"  if (/mi/);
	$chord_style="low" if (/low/); }

    # -------------------------

    if ($columns == 2) {
	$pagewidth="0.47\\textwidth";
	$twocolumns="[twocolumn]";

	$hoffset=-1.1;
	$textwidth=16-2*$hoffset; }
    else {
	$pagewidth="0.9\\textwidth";
	$twocolumns="";

	$hoffset=-0.5;
	$textwidth=16-2*$hoffset;

	$hoffset-=2; }


    $font_sizes=0 if ($font_sizes<0);
    $font_sizes=3 if ($font_sizes>3);

    $text_font_size=$tex_font_size[$font_sizes+2];
    $chord_font_size=$tex_font_size[$font_sizes+1];
    $song_title_font_size=$tex_font_size[$font_sizes+4];
    
    $tabuline_max=180/(($font_sizes+1)**0.7*$columns**0.7);
    $tabuline_norm=$tabuline_max*(0.6)."em";
    $bearable_length=$tabuline_max*(0.85);

    # ------------------- Locale settings -------------------------
    
    # This is Czech collation for ISO 8859-2 character encoding.
    # We do not solve a problem of other encodings, also 
    # we don't know how to tell TeX to understand Codepage1250, for instace.
    # This collation is not prefect, but working pretty well.

    $collation{"czech"}{"list"}= "\"#$%&'()*+,-.:;<=>[\\]'`{}".
        "0123456789 ABCDEFGH".chr(0)."IJKLťMNOPQRSTUVWXYZ".
            "abcdefgh".chr(0)."ijklmnopqrstuvwxyz";
    $collation{"czech"}{"replace"}={"ch" => chr(0) };


    while (1) {
        if ($language eq "czech") {
            $alphabetical_name="Abecedn seznam";
            $transposed_by_1="Transponovno o ";
            $transposed_by_2=" plton.";
            last; }
        if ($language eq "german") {
            $alphabetical_name="Alphabetischer index";
            $transposed_by_1="Transponiert um ";
            $transposed_by_2=" Halbtne.";
            last; }

        # english is default
 	$alphabetical_name="Alphabetical index";
	$transposed_by_1="Transposed by ";
	$transposed_by_2=" halftones.";
        last; }

    # ----------------------

    $songtitles_newpage="";
    for ($title_style) {
	$songtitles_newpage="\\newpage" if (/songnewpage/); }

    $album_title_font_size="\\Huge";

    setup_collation(); 

    #print STDERR %collation_hash;
}


# }}}



# }}} 

# {{{  shared functions                 
sub min {
    return $_[0]<$_[1]?$_[0]:$_[1]; }

sub find_chords {
    my $crdprep = $_[0];
    for ($crdprep) {
	s/^[^\]]*\[//;
	s/\][^\]]*$//; }
    return split (/][^[]*\[/, $crdprep); }

sub find_text {
    # parameters: 1 - string of mixed text/chord
    #             2 - possibly bool indicating whether we sould
    #                 fix odd characters for tex
    @text = split (/\[[^:\]]*\]/,$_[0]);
    if ($_[1]) {
        for (@text) {
            $_=fix_odd_characters($_); }}
    return @text; }
# }}}
# {{{  transposition "class"            

# transposition functions and constants are listed
# here because they are neede not only in transposition
# but also in tex setting


# {{{ constants                        
%chord_to_offset = ("C", 0,"C#",1, "Db",1,
                    "D", 2, "D#",3, "Eb",3,
                    "E", 4,
                    "F", 5,"F#",6,"Gb",6,
                    "G", 7,"G#",8,"Ab",8,
                    "A", 9,"A#",10,"Bb",10,
                    "H", 11,
                    "B", 11);

# chord_price

for my $offset (0..11) {
    for my $minor (0..1) {
	$chord_price[$offset][$minor]=0; }}

$chord_price[0][0]=-2;
$chord_price[5][0]=-1;
$chord_price[7][0]=-1;
$chord_price[2][1]=-1;
$chord_price[4][1]=-1;
$chord_price[9][1]=-2;

# key_norm

@key_norm=("b","b","#","b","#","b","b","#","b","#","b","#");

# chord_barre

for my $offset (0..11) {
    for my $minor (0..1) {
        $chord_barre[$offset][$minor]=1; }}

$chord_barre[0][0]=0;
$chord_barre[2][0]=0;
$chord_barre[2][1]=0;
$chord_barre[4][0]=0;
$chord_barre[4][1]=0;
$chord_barre[7][0]=0;
$chord_barre[9][0]=0;
$chord_barre[9][1]=0;

# barre recognition is simplified
# e.g. B7 is not barre, but we care only about base note and
# major/minor.

# }}}

sub transpose_basic {
    # global $norm, $shift

    # Down shares 

    $transposed=$_[0];
    for (my $i=0; $i<$shift; ++$i) {
        transpose_basic_one_up();}

    # normalize
    if ($norm eq "b") {
        for ($transposed) {
            s/C\x23/Db/;
            s/D\x23/Eb/;
            s/F\x23/Gb/;
            s/G\x23/Ab/;
            s/A\x23/Bb/; }}
    else {
        for ($transposed) {
            s/Db/C\x23/;
            s/Eb/D\x23/;
            s/Gb/F\x23/;
            s/Ab/G\x23/;
            s/Bb/A\x23/; }}

    for ($transposed) {
        s/mi/m/;
        s/min/m/;
        s/H/B/; }
    return $transposed; }

sub transpose_basic_one_up {
    # global $transposed
    # Transpose one chord by one halftone up

    for ($transposed) {
	s/H/B/;
        if (s/C\x23/D/) {last;}
        if (s/D\x23/E/) {last;}
        if (s/F\x23/G/) {last;}
        if (s/G\x23/A/) {last;}
        if (s/A\x23/B/) {last;}

        if (s/Db/D/)    {last;}
        if (s/Eb/E/)    {last;}
        if (s/Gb/G/)    {last;}
        if (s/Ab/A/)    {last;}
        if (s/Bb/B/)    {last;}

        if (s/C/C\x23/) {last;}
        if (s/D/D\x23/) {last;}
        if (s/E/F/)     {last;}
        if (s/F/F\x23/) {last;}
        if (s/G/G\x23/) {last;}
        if (s/A/A\x23/) {last;}
        if (s/B/C/)     {last;}}}

sub transpose {
    # global @tpose, $transposition
    # global /*out*/ @tpose

    # $transposition is one of:
    #      . "nobarre"
    #      . an integer (number of halftones to be transposed up)
    #      . destination key
    
    # @tpose is an array of lines from chordpro songfile to be transposed

    # <i>Normalization</i> is setting either with # or with b depending on
    # key of the paragraph.



    # {{{ Count chord frequencies          

    #    count separately for each paragraph

    $paragraph=0;
    $was_space=1;

    for (@tpose) {
	chomp;$_.="\n";     #Every line _really_ has endline character

	# {{{ Chords
     
	if (/\[/) {
	    enter_paragraph_if_required();

	    my @chords = find_chords($_);

	    for (@chords) {
		s/^\((.*)\)$/$1/; #kill brackets
                
		s/\/.*$//;       #kill bass
		s/maj//;
		$minor=(/m/);
		$minor=0 if (not $minor);

		$base=substr($_,0,1);
		$base.="b" if (/^.b/);
		$base.="#" if (/^.\x23/);
		#print "$paragraph\n";
		++$chord_count[$paragraph][$chord_to_offset{$base}][$minor]; }
	    next }

	# }}}
	# {{{ Whitespace
	if (/^\s*$/) {
	    $was_space=1; next }
	# }}}
	# {{{ Text
	enter_paragraph_if_required();
	# }}}
    }
    $paragraphs=$paragraph;

    #    global statistics if nobarre transposition

    if ($transposition eq "nobarre") {
	for $minor (0..1) {
	    for $offset (0..11) {
		$song_chord_count[$offset][$minor]=0; }}
	for $paragraph (1..$paragraphs) {
	    for $minor (0..1) {
		for $offset (0..11) {
		    $song_chord_count[$offset][$minor]+=
			$chord_count[$paragraph][$offset][$minor]; }}}}
    

    # }}}
    # {{{ Determine best keys              

    for ($paragraph=1; $paragraph<=$paragraphs; ++$paragraph) {

	# {{{ debugging print
	#	print $chord_count[$paragraph];print "\n\n";

	#for my $minor (0..1) {
	#    print "min:$minor: ";
	#    for my $chord (0..11) {
	#	print "$chord_count[$paragraph][$chord][$minor] ";
	#    }
	#    print "\n";
	#}
	# }}}

	$bestvalue0=10000;
	$bestkey0=0;
	for $key (0..11) {
	    $value=0;
	    for my $chord (0..11) {
		for my $minor (0..1) {
		    $value+=$chord_price[($chord-$key) % 12][$minor] *
                        $chord_count[$paragraph][$chord][$minor]; }}
	    $bestvalue0=$value,$bestkey0=$key if $value<$bestvalue0; }
	$bestkey[$paragraph]=$bestkey0; 
	$bestvalue[$paragraph]=$bestvalue0; }
    # }}}
    # {{{ Determine numeric shift          
    if ($transposition eq "nobarre") {
	$bestshift=0;
	$bestprice=100000;
	for $shift (0..11) {
	    $price=0;
	    for $minor (0..1) {
		for $offset (0..11) {
		    $price+=($song_chord_count[$offset][$minor]
			     * $chord_barre[($offset+$shift)%12][$minor]) }}
	    if ($price<$bestprice) {
		$bestprice=$price;
		$bestshift=$shift; }}
	$shift=$bestshift; }
    elsif ($transposition =~ /^[-0-9]+$/) {
	$shift=$transposition % 12; }
    else {
	$shift=-1;
	for $paragraph (1..$paragraphs) {
	    if ($bestvalue[$paragraph]<0) {
		if (not exists $chord_to_offset{$transposition}) {
		    warning("Key \"$transposition\" is unknown.\n");
		    exit; }
		$shift=($chord_to_offset{$transposition}-$bestkey[$paragraph]) % 12;
		last; }}}
    # }}}
    # {{{ Transpose and normalize          
    $paragraph=0;
    $was_space=1;

    for (@tpose) {
	if (/\[/) {                       # Chord instructions  
	    if ($was_space) {
		$was_space=0;
		++$paragraph;
		$norm=$key_norm[($bestkey[$paragraph]+$shift)%12]; }

	    # {{{ Ensure chords contain no spaces
	    if (/\[[^\]]* [^\]]*\]/) {
		warning "\nSetchord: Chords cannot contain spaces.\n";
		warning "This was broken at file $ARGV:\n";
		warning $_;
		exit; }
	    # }}}

	    my @text = split (/\[[^\]]*\]/,$_);
	    my @chords = find_chords($_);
	    # {{{ Transpose
	    for (@chords) {
		@basses = split (/\//,$_);
		$tpose=transpose_basic($basses[0]);
		$tpose.="/".transpose_basic($basses[1]) if ($#basses==1);
		$_=$tpose; }
	    # }}}
	    # {{{ Print everything out
	    my $out = shift @text;
	    my $textpos=0;
	    for (@chords) {
		$out.="[$_]$text[$textpos]";
		++$textpos; }
	    $_= $out;            # Write the result back to array
	    # }}}
	    next; }
	if (/^\s*$/) {                    # Whitespace                     
	    $was_space=1; next; }
	if ($was_space) {                 # ext or instruction            
	    $was_space=0;
	    ++$paragraph;
	    $norm=$key_norm[($bestkey[$paragraph]+$shift)%12]; }}
    # }}}
    # {{{ Inform about cappo (the case of nobarre)
    if ($transposition eq "nobarre" and $shift!=0) {
	$capo=(12-$shift);
	if ($capo<6) {
	    $capotext="{c:Cappo $capo}\n"}
	else {
	    $capotext="{c:".$transposed_by_1.$shift.$transposed_by_2."}\n"}

	splice @tpose,1,0,$capotext; }
    # }}}
}

sub enter_paragraph_if_required {
    # initializes @chord_count array by the way
    if ($was_space) {
	++$paragraph; $was_space=0;

	for my $chord (0..11) {
	    for my $minor (0..1) {
		$chord_count[$paragraph][$chord][$minor]=0;}}}}


# }}}

# {{{  collation functions              
sub setup_collation {
    # global $language,%collation
    # print STDERR "[".$language."]";

    if (defined($collation{$language})) {
        #print STDERR "defined";
        @collation_list=split(//,$collation{$language}{"list"});
        $i=0;
        for (@collation_list) {
            $collation_hash{$_}=$i;
            ++$i;}}
    if (defined($collation{$language}{"replace"})) {
        $collation_replace_ref=$collation{$language}{"replace"};
        %collation_replace=%$collation_replace_ref; }}

sub by_locale_collation {
    # global $language,%collation
    # print STDERR "byloc";

    my $aa=$a;
    my $bb=$b;
    while (($old, $new) = each %collation_replace) {
        $aa=~s/$old/$new/g;
        $bb=~s/$old/$new/g; }

    $i=0;
    $min_length=min(length($aa),length($bb));
    # print STDERR $min_length;
    while ($i<$min_length) {
        # print STDERR "[".substr($aa,$i,1)."]";
        if ($collation_hash{substr($aa,$i,1)} < $collation_hash{substr($bb,$i,1)}) {
            return -1; }
        if ($collation_hash{substr($aa,$i,1)} > $collation_hash{substr($bb,$i,1)}) {
            return 1; }
        ++$i; }
    return 0; }
# }}}

$task = shift @ARGV;

# {{{  undefined task                   
if (not defined($task)) {
    print STDERR $help_message;
    exit; }
# }}}
# {{{  learn os dependecies             
$long_newlines_os=0;
if ($^O eq "dos" or $^O eq "MSWin32" or $^O eq "os2") {
    $long_newlines_os=1; }
# }}}
# {{{  tex                              

    # {{{  to_nobarre_if_required          
    sub to_nobarre_if_required {
        if ($nobarre) {
            my $songstart=0;
            @tpose=();
            push @input,"{title:none}";          # Add one false song start at an end
            my $i=0;
            while ($i<=$#input) {
                if ($input[$i] =~ /\x7btitle:/) {
                    $transposition="nobarre";
                    transpose();
                    #warning "I transpose, sir.\n";
                    splice @input,$songstart,$i-$songstart,@tpose;
                    $i=$songstart+$#tpose+1; # Correct $i so that it points to
                    # position after inserted transposed song
                    @tpose=$input[$i];
                    $songstart=$i; }
                else {
                    push @tpose,$input[$i]; }
                ++$i;}
            pop @input; } # Pop false song start
    }

# }}}
    # {{{  set_one_chord                   
sub set_one_chord {
    my $set="";
    $_=$_[0];
    
    # {{{ Switch B <-> H notation (B is common)
    if ($H_chord) {
        s/B([^b])/H$1/g;
        s/B$/H/g; }
    else {
        s/H/B/g; }
    # }}}

    $set.="\\sf ";
    # It is nice to represent special sequences with nonprintable characters.
    s/maj/\001/;s/mi/m/;s/min/m/;s/dim/\002/;s/m75-/z/;
    s/\0017/\001/;s/7\001/\001/;

    #                 brackets
    my $brackets=0;
    if (/^\(.*\)$/) {
        s/\(//;s/\)//;
        $brackets=1;
        $set.="("; }
    #                 basses
    my $bass="";
    if (/\//) {
	@basssplit = split(/\//,"$_");
	($bass = $basssplit[1]) =~ s/\043/h/;  #043 is octal hash
	$_ = $basssplit[0]; }

    my $majset;my $dimset;my $minorset;my $minorshiftedbase;

    # {{{ Chord style dependencies
    for ($chord_style) {
	if (/^\-$/) {
	    $majset="\$\\triangle\$";
	    $dimset="o";
	    $minorset="\\raisebox{0.26ex}{--}";
	    $minorshiftedbase="F";
	    last}
	if (/^mi$/) {
	    $majset="maj7";
	    $dimset="dim";
	    $minorset="mi";
	    $minorshiftedbase="?";
	    last}
	if (/^m$/) {
	    $majset="7maj";
	    $dimset="dim";
	    $minorset="m";
	    $minorshiftedbase="?";}
	if (/^low$/) {
	    $majset="7maj";
	    $dimset="dim";
	    $minorset="low";
	    $minorshiftedbase="?";}}
    # }}}

    my $bot="";  my $top="";
    my $bot0=""; my $top0="";
    my $puttobot=0;
    my $numfound=0;
    my $force_stay_in_upper_index=0;
    my @CHORD = split (//, $_);
    $basenote=uc(shift @CHORD);     # uc() is upper_case()

    
    # if not reasonable chord, do not try to set indices
    if (not $basenote=~/[ABCDEFGH]/) {
        return "\\sf ".$_[0]."\\hskip.7em"; }

    #$set.=$basenote;
    for (@CHORD) {
	if ($puttobot) { $bot.=$_; next; }
	if ($numfound and /[2-9]/ and not $force_stay_in_upper_index) {
            $bot.=$_; $puttobot=1; next; }

        if (/[-\(]/) {
            $force_stay_in_upper_index=1; $top.=$_; next; }
        if (/\)/) {
            $force_stay_in_upper_index=0; $top.=$_; next; }

	if (/\001/) {
	    my $dest=\$top;
	    if ($numfound) {
		$puttobot=1;
		$dest=\$bot;}

	    if ($chord_style eq "mi") {
		$$dest.=7;
		$bot0.=" " if $bot0;
		$bot0.="maj";
		$numfound=1; next; }
	    $$dest.=$majset; $numfound=1;  next; } # maj

	if (/[2-9]/) { $top.="$_"; $numfound=1; next; }
	if (/\002/) { $top.=$dimset;            next; } # dim
	if (/z/)    { $top.="\$\\varnothing\$"; next; }
	if (/b/)    { $top0.="\$\\hskip0.1em\\mathbf{\\flat}\$"; next; }
	if (/\x23/) { $top0.="\$\\hskip0.1em\\mathbf{\\sharp}\$"; next; }
	# \x23 is octal hash

	if (/m/)    {                        # minor
	    if ($chord_style eq "-" and 
		not $basenote eq $minorshiftedbase) {$bot0.="\\hskip0.1em"}
	    $bot0.=$minorset; next;}        
	if (/\+/)   { $bot.="+"; next; }     # +
	$top.="$_"; }

    # Set basenote

    if ($chord_style eq "low" and $bot0) {
	$set.=lc($basenote);
	$bot0=""; }
    else {
	$set.=$basenote; }

    # Now INDEXES are really nasty
  INDEXES: {
      if (not $top0 and not $bot and $bot0 and $top and $chord_style eq "-") {
	  $set.="\\crdx{$top}{$bot0}{}{}"; # Typical case of Fm7
	  last INDEXES; }
      if (not $top and $bot eq "+") {
	  if ($top0 =~ /flat/) {
	      $set.="\\crdx{$top0}{$bot0}{}{}\\hskip-.3em+";
	      last INDEXES; }
	  
	  $set.="\\crdx{$top0}{$bot0}{}{}\\hskip-.1em+";
	  last INDEXES; }

      if ($top =~ /dim/) {      #case of dim in "m" and "mi" style setting
	  $set.="\\crdx{$top0}{$bot0}{}{}dim";
	  last INDEXES; }

      $set.="\\crdx{$top0}{$bot0}{$top}{$bot}";
  }
    #

    @basses = split(//,$bass);
    $set.="\\crdbass{$bass}{}"                if ($#basses==(1-1));
    $set.="\\crdbass{$basses[0]}{$basses[1]}" if ($#basses==(2-1));
    
    $set.=")"                                 if ($brackets);
    
    $set.="\\hskip.7em";
    return $set; }


# }}}
    # {{{  set_tex_head                    
sub set_tex_head {

    finalize_options();
    if (defined($output_file_base)) {
        create_alphabetical_toc ($output_file_base); }

    to_nobarre_if_required();

    $head="\\documentclass${twocolumns}{article}\n";
    if ($language eq "czech") {
        $head.="\\usepackage{czech}\n"; }
    if ($inputenc) {
        $head.="\\usepackage[$inputenc]{inputenc}\n"; }
    if ($language eq "german") {
        $head.="\\usepackage{german}\n"; }
    $head.="\\usepackage{palatino}
\\usepackage{amsfonts,amssymb}
\\usepackage{colortbl}
\\usepackage{verbatim}
\\usepackage{graphics}
\\usepackage{exscale}
\\textwidth=${textwidth}cm
\\hoffset=${hoffset}cm
\\textheight=26cm
\\voffset=-3cm
%
%
%   ==================================
%      Commands and environments
%   ==================================
%
%
\\newcommand{\\spc}{\\setbox0=\\hbox{x}\\hskip\\wd0}
\\newcommand{\\largeskip}{\\bigskip\\bigskip}
% silent \\par not producing undefull hboxes (hack a little)
\\newcommand{\\spar}{\\rule{0pt}{0pt}\\par}

\\newcommand{\\maxskip}[2]{%
\\setbox0=\\hbox{#1}\\setbox1=\\hbox{#2}%
\\ifdim\\wd0<\\wd1\\hskip\\wd1\\else\\hskip\\wd0\\fi}%

\\newdimen\\tempdimen%

\\newcommand{\\filldifrule}[3]{%
\\setbox0=\\hbox{#1}\\setbox1=\\hbox{#2}%
\\ifdim\\wd1<\\wd0%
\\tempdimen=\\wd0%
\\advance\\tempdimen by - \\wd1%
\\ifdim\\tempdimen<0.3em\\tempdimen=0.3em\\fi%
\\advance\\tempdimen by -0.1em%
\\hskip0.05em%
\\rule[.5ex]{\\tempdimen}{0.12ex}%
\\hskip0.05em%
\\else%
#3%
\\fi}

\\newcommand{\\skipdif}[2]{%
\\setbox0=\\hbox{#1}\\setbox1=\\hbox{#2}%
\\ifdim\\wd1<\\wd0%
\\tempdimen=\\wd0%
\\advance\\tempdimen by - \\wd1%
\\hskip\\tempdimen%
\\fi}

\\newcommand{\\leftrepeat}{%
\\rule[-0.3ex]{0.05em}{2ex}\\hskip0.1em\\rule[-0.3ex]{0.05em}{2ex}%
\\hskip0.1em\\raisebox{0.1ex}{:} }

\\newcommand{\\rightrepeat}{%
 \\raisebox{0.1ex}{:}\\hskip0.1em%
\\rule[-0.3ex]{0.05em}{2ex}\\hskip0.1em\\rule[-0.3ex]{0.05em}{2ex}}

";

$song_title_shared_start=
"\\newcommand{\\songtitle}[2]{
\\spar\\vfill
$songtitles_newpage%
\\begin{minipage}{$pagewidth}%
\\addcontentsline{toc}{subsection}{#1}%
";

$song_title_shared_end="\\bigskip
\\end{minipage}\\nopagebreak[4]\\par\\nopagebreak[4]}";



SONGTITLE: {
    if ($title_style =~ /norule/) {
	$head.=$song_title_shared_start.
"{$song_title_font_size \\sf\\bfseries #1\\\\[0.2ex]}%
{\\it #2}%
".$song_title_shared_end;
	last SONGTITLE; }

    if ($title_style =~ /graybox/) {
	$head.=$song_title_shared_start.
"\\begin{tabular}{>{\\columncolor[gray]{0.8}}p{\\textwidth}}%
$song_title_font_size \\sf\\bfseries\\rule{0pt}{1.6ex}#1%
\\end{tabular}\\\\[1.5ex]%
{\\it #2}%
".$song_title_shared_end;
	last SONGTITLE; }

    # default style - rule

    $head.=$song_title_shared_start.
    "\\rule{\\textwidth}{.5ex}\\\\[1.3ex]\n".
    "{$song_title_font_size \\sf\\bfseries #1\\\\[0.2ex]}%\n".
    "{\\it #2}%\n".$song_title_shared_end;

}

    $head.="
\\newcommand{\\albumtitle}[1]{
%\\spar
\\vfill
\\newpage
\\begin{minipage}{$pagewidth}
\\addcontentsline{toc}{section}{#1}
\\rule{\\textwidth}{.7ex}\\\\
$album_title_font_size \\sf\\bfseries #1%
\\bigskip\\bigskip\\bigskip
\\end{minipage}}

\\newcommand{\\tabuline}[1]{
\\def\\emptyparameter{}%
\\def\\currentparameter{#1}%
\\ifx\\emptyparameter\\currentparameter%
\\colorbox[gray]{0.87}{\\rule{0pt}{1ex}\\rule{$pagewidth}{0pt}}%
\\else%
\\colorbox[gray]{0.87}{\\resizebox{$pagewidth}{1.5ex}{%
\\rule{0pt}{1.5ex}#1\\setbox0=\\hbox{#1}\\hskip-\\wd0\\rule{$tabuline_norm}{0pt}%
}}\\fi\\\\[-0.3ex]}
";

    $head.= "
\\newcommand{\\crdx}[4]{
\\hskip-0.3em\\lower-0.2ex\\hbox{$chord_font_size\$^\\textsf{#1}_\\textsf{#2}\$}%
\\hskip0.25em
\\if:#1:\\if:#2:\\hskip0.1em\\fi\\fi
\\hskip-0.3em\\lower-0.2ex\\hbox{$chord_font_size\$^\\textsf{#3}_\\textsf{#4}\$}}
"  if ($chord_style eq "-");

    $head.= "
\\newcommand{\\crdx}[4]{
\\hskip-0.3em\\lower-0.2ex\\hbox{$chord_font_size\$^\\textsf{#1}\$}%
\\hskip0.25em%
\\if:#2:
\\else\\hskip-0.3em{}#2\\hskip0.3em\\fi
\\hskip-0.3em\\lower-0.2ex\\hbox{$chord_font_size\$^\\textsf{#3}_\\textsf{#4}\$}}
"  if ($chord_style =~ /m|mi|low/);

    $head.= "
\\newcommand{\\crdbass}[2]{
\\hskip-0.4em\\big/#1\\crdx{\$%
\\if b#2%
\\flat\\fi\\if h#2%
\\sharp\\fi\$}{}{}{}}

\\newenvironment{tabbingnb}
{\\noindent
\\begin{minipage}{0.4\\textwidth}\\begin{tabbing}}
{\\end{tabbing}\\end{minipage}\\par\\vskip-\\baselineskip}\n";

$head_after_begin_document="
%
%
%            ===========================
%                  BEGIN DOCUMENT
%            ===========================
%
%
\\begin{document}
\\setlength{\\parindent}{0pt}
\\boldmath
$text_font_size\n";
$head_after_begin_document.="\\csprimeson\n" if ($language eq "czech");

#------------------------------------

$table_of_contents.= "
%
%
%                =====================
%                  TABLE OF CONTENTS
%                =====================
%
%
\\thispagestyle{empty}

\\tableofcontents

%This is macro of Petr Olsak. It inputs the file but
%does not cry, if file does not exist

\\newread\\testin
\\def\\softinput #1 {\\let\\next=\\relax \\openin\\testin=#1
\\ifeof\\testin%
\\else\\closein\\testin\\def\\next{\\input #1 }\\fi
\\next}

% Insert alphabetical table of contents,
% if there is one

\\openin\\testin=\\jobname.atoc
\\ifeof\\testin\\closein\\testin%
\\else\\closein\\testin
\\newpage
\\section*{$alphabetical_name}
\\softinput \\jobname.atoc
\\fi

\\clearpage\n";

$titlepage_head="
%
%        =======================
%               Titlepage
%        =======================
%
\\thispagestyle{empty}
\\ 
\\vskip16\\baselineskip
{\\Huge
\\begin{tabular*}{\\textwidth}{c}
\\hskip\\textwidth\\ \\\\
\\bfseries ";

$titlepage_tail= "
\\end{tabular*}}
\\clearpage";

}
# }}}
    # {{{  fix_odd_characters              
sub fix_odd_characters {
    # fix odd characters for normal text and chords
    # (there is other slightly different fixing process for tabulatures)

    $_=$_[0];

    # Backslashes previously inserted by chordpack
    # are coded by character with ascii code 01.

    # assumption - there are no nonprintable characters
    # this assumption may later be explicitly checked

    s/\\/\x00/g;  # mark backslashes
   
    for ($ascii=33;$ascii<=38;++$ascii) {
        $re="\\x".sprintf "%.2x",$ascii;
        s/$re/\\char$ascii\x02/g; }        #\x02 is reserved for {}

    s/\{/\$\\{\$/g;    s/\}/\$\\}\$/g;
    s/\^/\\char094\x02/g;
    s/\|/\$\|\$/g;
    s/</\$<\$/g;
    s/>/\$>\$/g;
    s/~/\\~{}/g;
    s/\[/\$\[\$/g;    s/\]/\$\]\$/g;

   
    # backslashes must be done on their own
    s/\x00/\$\\backslash\$/g;
    s/\x01/\\/g;
    s/\x02/\{\}/g;
    return $_;
}
# }}}
    # {{{  set_songtitle                   
sub set_songtitle {
    # global $songtitle
    # global @subtitles

    $subtitle_set="";
    for (@subtitles) {
        $subtitle_set.=$_."\\\\"; }
    print "%\n%\n%\n%\n\\songtitle{$songtitle}{$subtitle_set}%\n"; }

# }}}
    # {{{  previous_block_care             
sub previous_block_care {
    # global $previous_block

    $pb=$previous_block;

    if ($previous_block==1) {}

    if ($pb==1) {
        print $_[0]; }
    if ($pb==2) {
        print $_[1]; }
    if ($pb==3) {
        set_songtitle(); }
    $previous_block=0; }  # global change

# }}}
    # {{{  create_alphabetical_toc         
sub create_alphabetical_toc {
    # global $previous_block

    # print STDERR "creating alphabetical";

    $output_file_base=$_[0];

    if (open(TOC,$output_file_base.".toc")) {
	while (<TOC>) {
	    push @toc,$_; }
        close (TOC);

        # There may be a problem with sorting for languages. I do not know a solution.
        # I suppose in that case alphabetical must be edited manually.

        # To be done:
        #     . switch and option producing alphabetical
        #     . discuss languages
        #     . update documentation (not alphabetical, but atoc)

        # print STDERR %collation_hash;

        @sorted_toc = defined(%collation_hash) ? sort by_locale_collation @toc : sort @toc; 
        @alpha_toc = grep(!/{sect.*}/, @sorted_toc);    
        
        open(ATOC,">".$output_file_base.".atoc");
        for (@alpha_toc) {
            print ATOC $_; }
        close (ATOC); }}

# }}}


if ($task eq "tex") {

    my $previous_line=0;
    $previous_block=0;
    # previous_line:  0=emptyline,      1=text_line, 2=chord, 3=songtitle, 4=albumtitle
    # previous_block: 0=we're in block, 1=text_line, 2=chord, 3=songtitle, 4=albumtitle


    # Definitions:
    #    White line is a line which contains only whitespace character.
    #    Block is a maximal sequence of lines which are not white.
    #    Lines can be of several kinds, one block can contain lines of
    #    different kinds.
    #    A kind of a block is the kind of last line of that block.

    #    Variable Previousblock contains the kind of previous block.
    #    An exception to this is songtitle, which sets previousblock explicitly
    #    as it's current block.

    %files_warned=();
    $head_printed=0;
    $verbatim_tex=0;
    $table_of_contents_printed=0;
    $tex_prebegin_part=0;
    $in_tablature=0;
    $subtitles_enabled=0;

    # {{{ Read input into @input variable  

    @input=();
    $stdout_opened=0;
    if (defined($opt_f)) {

	open(FILE,"$opt_f") or warning("File \"$opt_f\" does not exist."),exit;
	$mainpath=$opt_f;$mainpath =~ s|/[^/]*$|/|; chdir "$mainpath";

	$verbatim_lines=0;
	while(<FILE>) {
	    if (/^\x23/)    {next}                      # comment
	    if (s/^ //)     {push @input,"$_";next}     # just one line is verbatim
	    if (/^\s*$/)    {next}                      # whitespace line

	    chomp;
	    open(FILE2,"$_") or warning("File \"$_\" does not exist."),exit;
	    my $filename="$_";
	    while(<FILE2>) {
		#check_for_the_length("$_",$filename,$bearable_length);
		push @input,"$_"; }
	    close(FILE2);}
	close(FILE);

	# Open output
	$output_file=$opt_f;
	for ($output_file) {
	    if (not s/\.[^.]*$/.tex/) {
		s/$/.tex/; }}

        # Alphabetical file
        $output_file_base=$output_file;
        $output_file_base=~s/\.[^.]*$//; # remove .tex

	open(STDOUT,">".$output_file);
	$stdout_opened=1; }
    else {
	while (<>) {
	    #check_for_the_length("$_",$ARGV,$bearable_length);
	    push @input,"$_"; }}

    # }}}
   
    for (@input) {
        chomp;
        # {{{ Remove carriage return          
        if (not $long_newlines_os) {
            if (s/\x0d//g) {
                if (not $carriage_return_warned) {
                    warning "Your chordpro files have DOS carriage return ends of line".
                        " - not a serious problem.\n";
                    $carriage_return_warned=1; }}}
        # }}}

        # {{{ Parenthesis                     
        s/\" /\'\' /g;
        s/\"$/\'\'/g;
        s/ \"/ \`\`/g;
        s/^\"/\`\`/g;
        # }}}

        #                                Process line

        # {{{  Head not yet printed           
        if (not $head_printed) {
            # {{{ Remove comment
            s/\x23.*$//; 
            # }}}
            
            # {{{ In TeX prebegin
            if ($tex_prebegin_part) {
                if (/\173tex_prebegin_end/) {
                    $tex_prebegin_part=0;
                    set_tex_head();
                    print "$head";
                    print "$tex_prebegin_text";
                    print "$head_after_begin_document";
                    $head_printed=1;
                    next; }
                $tex_prebegin_text.="$_\n"; next}
            # }}}

            # {{{ Chordstyle
            if (/{chordstyle:.*}/) {
                if ($from_options{"chord_style"}) {
                    next; }

                s/{[^:]*: *//; s/}//;
                $chord_style=$_;
                next; }
            # }}}
            # {{{ Language
            if (/{language:.*}/) {
                if ($from_options{"language"}) {
                    next; }

                s/{[^:]*: *//; s/}//;
                $language=$_;
                next; }
            # }}}
            # {{{ Fontsize
            if (/{fontsize:.*}/) {
                if ($from_options{"font_sizes"}) {
                    next; }

                s/{[^:]*: *//; s/}//;

                $font_sizes=$_;
                next; }
            # }}}
            # {{{ Title style
            if (/{titlestyle:.*}/) {
                if ($from_options{"title_style"}) {
                    next; }

                s/{[^:]*: *//; s/}//;

                $title_style=$_;
                next; }
            # }}}
            # {{{ Columns
            if (/{columns:.*}/) {
                if ($from_options{"columns"}) {
                    next; }

                s/{[^:]*: *//; s/}//;

                $columns=$_;
                next; }
            # }}}

            # {{{ Emptyline
            if (/^\s*$/) {
                next; }
            # }}}

            # {{{ Songbook title
            if (/{songbooktitle:.*}/) {
                s/{[^:]*: *//; s/}//;
                s/&/\\&/g;

                @titlelist = split (/\^/, $_ );
                
                set_tex_head();	    
                print "$head";
                print "$head_after_begin_document";
                print "$titlepage_head";

                for (@titlelist) {
                    print "$_\\\\\n"; }

                print "$titlepage_tail";
                print "$table_of_contents";
                $table_of_contents_printed=1;
                
                $head_printed=1;
                next; }
            # }}}
            # {{{ Songbook title not found
            if (/{tex_prebegin_start.*}/) {
                $tex_prebegin_part=1;
                $tex_prebegin_text=""; next}
            
            set_tex_head();
            print "$head";
            print "$head_after_begin_document";
            $head_printed=1;
            # }}}
        }
        # }}}
        # {{{  Command allowed only in before head
        if (/{fontsize.*}/ or /{language.*}/ or /{titlestyle.*}/ or /{columns.*}/
            or /{chordstyle.*}/ ) {
            warning ("Command $_ can be used only before first {album: } or {title: } command is used.\n");
            next; }
        # }}}
        # {{{  In Verbatim TeX                
        if ($verbatim_tex) {
            if (/{vtexe.*}/ or /{verbatim_tex_end.*}/) {
                $verbatim_tex=0; next; }
            print "$_\n"; next; }
        # }}}
        # {{{  In tablature                   
        if ($in_tablature) {
            if (/{eot.*}/ or /{end_of_tab.*}/) {
                $in_tablature=0;
                if (not $ignore_tablature) {
                    print "\\end{minipage}\n"};
                next}

            if (not $ignore_tablature) {
                $_=substr($_,0,$tabuline_max);
                s/^ +$//g; #no whitespace lines
                
                # {{{ ascii based translation             
                s/\\/\x00/g;  #mark backslashes
                s/ /\x01/g;   #mark spaces
                for ($ascii=33;$ascii<=47;++$ascii) {
                    $re="\\x".sprintf "%.2x",$ascii;
                    s/$re/\\char$ascii /g; }
                for ($ascii=93;$ascii<=96;++$ascii) {
                    $re="\\x".sprintf "%.2x",$ascii;
                    s/$re/\\char$ascii /g; }
                for ($ascii=123;$ascii<=126;++$ascii) {
                    $re="\\x".sprintf "%.2x",$ascii;
                    s/$re/\\char$ascii /g; }
                # backslashes and spaces must be done on their own
                s/\x00/\\char92 /g;
                s/\x01/\\hskip0.602em /g;
                # }}}

                print "\\tabuline{$_}\n";}
            next}
        # }}}

        #                                Line contains

        # {{{  Comment (programmer's kind of) 
        if (/^\043/) {    # 043 is octal of hash
            next}
        # }}}

        # {{{  Subtitles_on command               
        if (/{subtitles_on.*}/) {
            $subtitles_enabled=1;
            next; }
        # }}}
        # {{{  Subtitles_off command               
        if (/{subtitles_off.*}/) {
            $subtitles_enabled=0;
            next; }
        # }}}

        # {{{  Start of verbatim TeX          
        if (/{vtexs.*}/ or /{verbatim_tex_start.*}/) {
            $verbatim_tex=1; next }
        # }}}
        # {{{  Start of Tablature             
        if (/{sot.*}/ or /{start_of_tab.*}/) {
            previous_block_care("\\spar\n","\\spar\\largeskip\n");
            $in_tablature=1;	  
            if (not $ignore_tablature) {
                print "\n\\begin{minipage}{\\textwidth}\\tt\n";
                $previous_line=1; }
            next; }
        # }}}

        # {{{  Table of contents              
        if (/{toc.*}/ or /{table_of_contents.*}/) {
            if ($table_of_contents_printed) {
                warning("You ask me to print table of contents though it\n".
                        "has already been printed with songbook's titlepage.\n"); }
            else {
                print "$table_of_contents"; }
            next; }
        # }}}

        # {{{  Title command                  
        if (/{t:.*}/ or /{title:.*}/) {
            s/{[^:]*: *//; s/}//;

            if ($previous_line!=0) {
                $previous_block=$previous_line }
            #$previous_line=0;
            
            # print "\\bigskip"            if ($previous_line==0);
            previous_block_care("\\bigskip","\\bigskip\\bigskip");

            #s/&/\\&/g;                   # hack, I don't like this
            #print "%\n%\n%\n%\n\\songtitle{$_}{}%\n";
            $previous_line=3;
            $previous_block=3;    # explicit previousblock

            $songtitle=fix_odd_characters($_);
            #$songtitle=$_;
            @subtitles=();
            next; }
        # }}}
        # {{{  Subtitle command               
        if (/{st:.*}/ or /{subtitle:.*}/) {
            s/{[^:]*: *//; s/}//;
            
            if ($subtitles_enabled) {
                push @subtitles,fix_odd_characters($_); }
            $previous_block=3;    # explicit previous_block

            # ignored, so far
            #print "\n\\bigskip"          if ($previous_line==1);
            #print "\\bigskip\\bigskip"   if ($previous_line==2);
            #print "\\bigskip"            if ($previous_line==0);

            #s/\173[^:]*: *//; s/\175//;  # 173 is octal left curly brace 175 is right
            #s/&/\\&/g;
            #print "%\n%\n%\n%\n\\songtitle{$_}%\n";
            #$previous_line=3;
            next}
        # }}}
        # {{{  Album command                  
        if (/{album:.*}/) {
            
            print "\n\\bigskip"          if ($previous_line==1);
            print "\\bigskip\\bigskip"   if ($previous_line==2);
            print "\\bigskip"            if ($previous_line==0);

            s/\173[^:]*: *//; s/\175//;  # 173 is octal left curly brace 175 is right
            s/&/\\&/g;
            print "%\n" .
                "%\n" .
                "%          ======================\n" .
                "%            $_\n".
                "%          ======================\n" .
                "%\n" .
                "%\n\\albumtitle{$_}%\n";
            $previous_line=4;
            next}
        # }}}
        # {{{  Start of choir                 
        if (/{soc.*}/ or /{start_of_chorus.*}/) {
            print "\\it\n";
            next}
        # }}}
        # {{{  End of choir                   
        if (/{eoc.*}/ or /{end_of_chorus.*}/) {
            print "\\rm\n";
            next}
        # }}}
        # {{{  Comment                        
        if (/{c:.*}/ or /{comment:.*}/ or /{comment_italic:.*}/ or /{comment_box:.*}/) {
            s/{[^:]*: *//; s/}//;
            s/&/\\&/g;

            previous_block_care("\\spar\n","\\spar\\largeskip\n");

            print "{\\it $_\\rm}\\\\\n";
            $previous_line=1;  #Comment is close to ordinary text
            next}
        # }}}
        # {{{  Chord command (not chordpack)  
        if (/{ns.*}/ or /{new_song.*}/ or /{define.*}/ or /{textfont.*}/ or /{textsize.*}/
            or /{chordfont.*}/ or /{chordsize.*}/ or /{no_grids.*}/ or /{ng.*}/ or
            /{grid.*}/ or /{g.*}/ or /{new_page.*}/ or /{np.*}/ or /{new_physical_pages.*}/ or
            /{npp.*}/ or /{columns_break.*}/ or /{colb.*}/) {
            warning($_.": Here is a command of chord but not of chordpack\n");
            next}
        # }}}

        # {{{  Other command                  
        if (/{.+}/) {
            warning($_.": unrecognized command\n");
            next}
        # }}}

        # {{{  Repeat marks [: :]             
        # Final backslashes are represented by character with code 0
        # This DEPENDS on behaviour of fix_odd_characters function

        s/\[:/\x01leftrepeat/g;  s/:\]/\x01rightrepeat/g;
        # }}}

        # {{{  Chord instructions             
        if (/\[[^ ].*\]/) {
            $_.=" ";

            previous_block_care("\\spar\\bigskip\n","\\spar\\largeskip\n");
            # { Ensure chords contain no spaces
            if (/\[[^\]]* [^\]]*\]/) {
                warning "\nSetchord: Chords cannot contain spaces.\n";
                warning "This was broken at file $ARGV:\n";
                warning $_;
                exit;}
            # }

            s/\]\[/\] \[/g;               #no chords tightly follow

            # { Determine chord and text arrays
            my @text = find_text($_,1);
            my @chords = find_chords($_);
            # }
            # {{{ Print tab stops for chords, chords and text

            my $tabstops=$text[0];
            my $text_line=$text[0];
            my $chord_line="";
            my $i=1;
            for (@chords) {
                $crd = set_one_chord("$_");

                $text[$i] =~ s/^ /\\hskip.7em /;   #chord is preshifted to the left of the text
                #$tabstops.="\\=\\maxskip{$crd}{$text[$i]}";
                $chord_line.="\\>$crd";
                #$text_line.="\\>$text[$i]";
                # Join two broken parts of word, if needed
                $text=$text[$i];
                if ($i<$#text) {
                    $last_char=substr($text[$i],length($text[$i])-1,1);
                    $first_char=substr($text[$i+1],0,1);
                    if (($last_char =~ /^[^ .,]$/) and ($first_char =~ /^[^ .,]$/)) {
                        for ($text) {
                            if (s/ ([^ ])/ \\skipdif{$crd}{$text}$1/) {last;}
                            if (s/ / \\skipdif{$crd}{$text}/) {last;}

                            $present_dash="";
                            if(s/-+$//) {$present_dash="-"}                 # Remove dashes already present in adjacent
                            if($text[$i+1] =~ s/^-+([a-zA-Z])/$1/) {$present_dash="-"}  # texts
                            s/$/\\filldifrule{$crd}{$text}{$present_dash}/;}}}

                $text_line.="\\>$text";
                $tabstops.="\\=\\maxskip{$crd}{$text}";

                $text[$i] =~ s/^ /\\hskip.7em /g;  #chord is preshifted to the left of the text
                ++$i;}

            print "\\begin{tabbingnb}\n";
            print "$tabstops\\kill\n";
            print "$chord_line\\\\\n";      
            print "$text_line\\\\\n";
            print "\\end{tabbingnb}\n";

            # }}}

            $previous_line=2;
            next}
        # }}}
        # {{{  Spaces only                    
        if (/^ *$/) {
            $previous_block=$previous_line if ($previous_line!=0);
            $previous_line=0;
            next}
        # }}}
        # {{{  Text without chords            
        previous_block_care("\\spar\n","\\spar\\largeskip\n");

        print fix_odd_characters($_)."\\\\\n";
        $previous_line=1;
        # }}}
    }

    print "\\spar\\end{document}\n";
        exit; }

# }}}
# {{{  ascii                            
if ($task eq "ascii") {
    while (<>) {
        chomp;

        # Process line

        #                  Line contains
        # {{{  Title command
        if (/{t:.*}/ or /{title:.*}/) {
            
            s/{[^:]*: *//; s/}//;
            printf "$_\n";
            next; }
        # }}}
        # {{{  Other command
        if (/{.*}/) {next;}
        # }}}

        # {{{  Comment (programmer's kind of)
        if (/^\x23/) {    # \x23 is  hash
            next; }
        # }}}
        # {{{  Chord instructions
        if (/\[[^:]/) {
            $_.=" ";

            # {{{ Ensure chords contain no spaces
            if (/\[[^\]]* [^\]]*\]/) {
                warning "\nSetchord: Chords cannot contain spaces.\n";
                warning "This was broken at file $ARGV:\n";
                warning $_;
                exit; }
            # }}}
            

            s/\]\[/\] \[/g;    #no chords tightly follow

            # {{{ Determine chord and text arrays
            my @text = find_text($_);
            my @chords = find_chords($_);
            # }}}
            # {{{ Print chords and text

            my $chord_line=$text[0]; $chord_line =~ s/./ /g;
            my $textpos=1;
            my $text_line=$text[0];
            for (@chords) {
                $crd=$_;
                $chord_line.=$_ . (' ' x (length($text[$textpos])-length($crd)));
                $text_line.=$text[$textpos] . ' ' x (length($crd)-length($text[$textpos]));
                $textpos++; }

            print "$chord_line\n$text_line\n";
            
            # }}}

            next; }
        # }}}
        # {{{  Spaces only
        if (/^ *$/) {
            print "\n";
            next;}
        # }}}
        # {{{  Text without chords
        print "$_\n";
        # }}}
    }    
exit;
}
# }}}
# {{{  nochord                          
if ($task eq "nochord") {
    $in_tablature=0;
while (<>) {
    chomp;

    # Process line

    # {{{  In tablature                    
    if ($in_tablature) {
        if (/\x7beot/ or /\x7bend_of_tab/) {
            $in_tablature=0;
            next}
        next}
    # }}}

    #                         Line contains

    # {{{  Title command                   
    if (/{t:.*}/ or /{title:.*}/) {
        
        s/\173[^:]*: *//; s/\175//;  # 173 is octal left curly brace 175 is right
        printf "$_\n";
        next; }
    # }}}
    # {{{  Start of Tablature              
    if (/\x7bsot/ or /\x7bstart_of_tab/) {
        $in_tablature=1;
        next; }
    # }}}
    # {{{  Other command                   
    if (/{.*}/) {next;}
    # }}}

    # {{{  Comment (programmer's kind of)  
    if (/^\043/) {    # 043 is octal of hash
        next; }
    # }}}
    # {{{  Chord instructions              

    if (/\[/) {
        $_.="\n";

        my @text = find_text($_);

        for (@text) {
            print; }

        next; }

    # }}}
    # {{{  Spaces only                     
    if (/^ *$/) {
        print "\n";
        next;}
    # }}}
    # {{{  Text without chords             
    print "$_\n";
    # }}}
}    
exit;
}
# }}}
# {{{  pro                              

# Assumption: chord lines do not contain any tabulator characters.

$in_tabulature=0;

if ($task eq "pro") {
    $previous_was_chord_line=0;
while (<>) {
    chomp; $_.="\n";
    if ($previous_was_chord_line) {
        $previous_was_chord_line=0;

        chomp;
        $chord_line =~ s/\s+$//;
        $_.=" " x (length($chord_line)-length($_));

        $chord_end=length($chord_line)-1;
        $chord_curr=$chord_end;
        $looking_for_chord_end=1;
        while (1) {
            if ($looking_for_chord_end) {
                last if $chord_curr==-1;
                if (not substr($chord_line,$chord_curr,1) eq " ") {
                    $chord_end=$chord_curr;
                    $looking_for_chord_end=0; }}
            else {
                if ((substr($chord_line,$chord_curr,1) eq " ") or $chord_curr==-1) {
                    $looking_for_chord_end=1;
                    $chord=substr($chord_line,$chord_curr+1,$chord_end-$chord_curr);
                    $_=insertstring("[$chord]",$_,$chord_curr+1); }
                last if $chord_curr==-1; }
            --$chord_curr; }

        s/\+*$//;
        print "$_\n"; }
    else {
        if ($in_tabulature) {                         # In tabulature
            if (/{eot.*}/ or /{end_of_tab.*}/) {
                $in_tabulature=0; }
            print "$_"; }
        else {                                        # Not in tabulature
            if (/{sot.*}/ or /{start_of_tab.*}/) {
                $in_tabulature=1; }

            if (/^[ \/\+\x23()12345679A-Hbmajindsu]+$/ and not /^\s*$/) {
                # ^ Is this a chord line?
                $previous_was_chord_line=1;
                $chord_line=$_; }
            else {
                print "$_"; }}}}
exit; }
# }}}
# {{{  html                             

$chord_color_command="<font color=\"#aa4422\">";
# chord_color_command must be <font> tag. Atributes are optional

    # {{{  set_one_chord_html                
sub set_one_chord_html {
    $tdxs="<td><small>$chord_color_command";
    $tdxe="</font></small></td>";

    my $table_s="<table border=0 cellpadding=0 cellspacing=0>";
    
    my $set="";
    $_=$_[0];

    # {{{ Switch B <-> H notation (B is common)
    if ($H_chord) {
	s/B([^b])/H$1/g;
	s/B$/H/g; }
    else {
	s/H/B/g; }
    # }}}

    #$set.="\\sf ";
    # It is nice to represent special sequences with nonprintable characters.
    s/maj/\001/;s/mi/m/;s/min/m/;s/dim/\002/;s/m75-/z/;
    s/\0017/\001/;s/7\001/\001/;

    # {{{ brackets
    my $brackets=0;
    if (/^\(.*\)$/) {
	s/\(//;s/\)//;
	$brackets=1;
	$set.="(";
    }
    # }}}
    # {{{ basses
    my $bass="";
    if (/\//) {
	@basssplit = split(/\//,"$_");
	$bass = $basssplit[1];
	$_ = $basssplit[0];
    }
    # }}}

    my $majset;my $dimset;my $minorset;my $minorshiftedbase;

    # {{{ Chord style dependencies
#      if ($chord_style==0) {
#  	$majset="\$\\triangle\$";
#  	$dimset="o";
#  	$minorset="\\raisebox{0.26ex}{--}";
#  	$minorshiftedbase="F"; }
#      else {
    $majset="7maj";
    $dimset="dim";
    $minorset="m";
    $minorshiftedbase="?";
#      } 
    # }}}

    my $bot="";  my $top="";
    my $bot0=""; my $top0="";
    my $puttobot=0;
    my $numfound=0;
    my @CHORD = split (//, $_);
    $basenote=uc(shift @CHORD);
    for (@CHORD) {
	if ($puttobot) { $bot.="$_"; next; }
	if ($numfound and /[2-9]/) { $bot.="$_"; $puttobot=1; next; }
	if ($numfound and /\001/)  { $bot.=$majset; $puttobot=1; next; }
        
	if (/[2-9]/) { $top.="$_"; $numfound=1; next; }

	if (/\001/) { $top.=$majset; $numfound=1;  next; } # maj
	if (/\002/) { $top.=$dimset;               next; } # dim
	if (/z/)    { $top.="\$\\varnothing\$"; next; }
	if (/b/)    { $top0.="b"; next; }
	if (/\043/) { $top0.="#"; next; }
	# \043 is octal hash

	if (/m/)    {
	    #if (not $basenote eq $minorshiftedbase) {$bot0.="\hskip0.1em"}
	    $bot0.=$minorset; next;
	} # minor
	if (/\+/)   { $bot.="+"; next; }  # +
	$top.="$_";
    }


    $start_with_basenote="$table_s <tr><td>$chord_color_command$basenote</font></td>";

    # Now this really is nasty
  PRINT: {
      if (not ($top0 or $bot0 or $top or $bot)) { # No indices at all
	  $set.="$start_with_basenote";
	  $set.="$tdxs&nbsp;<br>&nbsp;$tdxe";
	  last PRINT; }

      if ($top =~ /dim/) {
	  $bot0="&nbsp;" if not $bot0;
	  $set.="$start_with_basenote";
	  $set.="$tdxs$top0<br>$bot0$tdxe"
	      if ($top0 or not $bot0 eq "&nbsp;");
          $set.="<td>${chord_color_command}dim</font></td>";
          last PRINT }

#      if (not $bot0 and not $bot) {               # No bottom indices
#	  $set.="$table_s<tr><td>$chord_color_command$basenote<td>";
#	  $set.="<td>$table_s $idxs$top0$top$idxe$idxs&nbsp;$idxe</table></td>" if ($top0 or $top);
#	  last PRINT; }
      
      if ($bot0) {
	  $bot="&nbsp;" if not $bot;
	  $set.="$start_with_basenote";
	  $set.="$tdxs$top0<br>&nbsp;$tdxe" if ($top0);
          $set.="$tdxs$bot0$tdxe";
	  $set.="$tdxs$top<br>$bot$tdxe";
          last PRINT }


      $bot0="&nbsp;";
      $bot="&nbsp;" unless ($bot);

      $set.="$start_with_basenote";
      $set.="$tdxs$top0<br>$bot0$tdxe" if ($top0 or $bot0);
      $set.="$tdxs$top<br>$bot$tdxe" if ($top or not $bot eq "&nbsp;");

  }
    #
    
    $set.="<td>$chord_color_command";
    @basses = split(//,$bass);
    $set.="/$bass"                if ($#basses==(1-1));
    if ($#basses==(2-1)) {
	$set.="/$basses[0]</font></td>";
	$set.="<td>$chord_color_command$basses[1]<br>&nbsp;</font></td>";
	$set.="<td>$chord_color_command";
    }
    
    $set.=")"                                 if ($brackets);
    $set.="&nbsp;</font></td></tr></table>";
    
    return $set;
}

# }}}

if ($task eq "html") {
    # {{{  head                            

      $head="<!doctype html public \"-//W3C//DTD HTML 4.0 Transitional//EN\">
<html>
<head>
<title>Songbook</title>
</head>
<body bgcolor=\"#eeeeee\">";

    print $head;

# }}}

    #                   Process input files

    my $previous_line=0; my $previous_block=0;
    # previous_line:  0=emptyline,      1=text_line, 2=chord, 3=title
    # previousblock: 0=we're in block, 1=text_line, 2=chord, 3=title

    $bearable_length=50;
    %files_warned=();
    $head_printed=0;
    $verbatim_tex=0;
    $table_of_contents_printed=0;
    $tex_prebegin_part=0;
    $it="";

    # {{{ Read input into @input variable  

    @input=();
    if (defined($opt_f)) {
        
	open(FILE,"$opt_f") or warning("File \"$opt_f\" does not exist."),exit;
	$mainpath=$opt_f;$mainpath =~ s|/[^/]*$|/|; chdir "$mainpath";

	$verbatim_lines=0;
	while(<FILE>) {
	    if ($verbatim_lines) {
		if (/^\^e/) {$verbatim_lines=0}          # end verbatimline mode
		else        {push @input,("$_")}
		next; }
	    if (/^\x23/)    {next}                      # comment
	    if (/^\^s/)     {$verbatim_lines=1;next}     # start verbatimline mode
	    if (s/^\^\^//)  {push @input,("$_");next}   # just one line is verbatim
	    if (/^\s*$/)    {next}

	    chomp;
	    open(FILE2,"$_") or warning("File \"$_\" does not exist."),exit;
	    my $filename="$_";
	    while(<FILE2>) {
		check_for_the_length("$_",$filename,$bearable_length);
		push @input,("$_"); }
	    close(FILE2);}
	close(FILE);
    }
    else {
	while (<>) {
	    check_for_the_length("$_",$ARGV,$bearable_length);
	    push @input,("$_"); }
    }

    # }}}


    for (@input) {
        chomp;
        # {{{ Parenthesis                     
        s/\" /\'\' /g;
        s/\"$/\'\'/g;
        s/ \"/ \`\`/g;
        s/^\"/\`\`/g;
        # }}}

        #                                  Process line
        # {{{  In Verbatim TeX                
        if ($verbatim_tex) {
            if (/{texe.*}/ or /{verbatim_tex_end.*}/) {
                $verbatim_tex=0; next; }
            print "$_\n"; next; }
        # }}}
        # {{{  In tablature                   
        if ($in_tablature) {
            if (/{eot.*}/ or /{end_of_tab.*}/) {
                $in_tablature=0;
                if (not $ignore_tablature) {
                    print "</pre></font></td></tr></table>\n"};
                next;}

            if (not $ignore_tablature) {
                print "$_\n";}
            next;}
        # }}}

        #                                Line contains:
        # {{{  Start of verbatim TeX          
        if (/{texs.*}/ or /{verbatim_tex_start.*}/) {
            $verbatim_tex=1; next; }
        # }}}
        # {{{  Start of Tablature             
        if (/{sot.*}/ or /{start_of_tab.*}/) {
            # {{{ Care about previous block
            if ($previous_block!=0) {
                print "<br>\n"   if ($previous_block==1);
                print "<br><br>\n" if ($previous_block==2);
                $previous_block=0;
            }
            # }}}
            $in_tablature=1;	  
            if (not $ignore_tablature) {
                print "<table><tr><td bgcolor=\"#dddddd\"><font size=\"-1\"><pre>\n";
                $previous_line=1;
            }
            next}
        # }}}
        # {{{  Table of contents              
        if (/{toc.*}/ or /{table_of_contents.*}/) {
            if ($table_of_contents_printed) {
                warning("You ask me to print table of contents though it\n".
                        "has already been printed with songbook's titlepage.\n"); }
            else {
                print "$table_of_contents"; }}
        # }}}

        # {{{  Title command                  
        if (/{t:.*}/ or /{title:.*}/) {
            
            print "\n<br>"          if ($previous_line==1);
            print "<br><br>"   if ($previous_line==2);
            print "<br>"            if ($previous_line==0);

            s/\173[^:]*: *//; s/\175//;  # 173 is octal left curly brace 175 is right
            s/&/&amp;/g;
            print "<br><br><br><br>\n<H3>$_</H3>\n";
            $previous_line=3;
            next;
        }
        # }}}
        # {{{  Album command                  
        if (/{album:.*}/) {
            
            print "\n<br>"          if ($previous_line==1);
            print "<br><br>\n"      if ($previous_line==2);
            print "<br>\n"            if ($previous_line==0);

            s/\173[^:]*: *//; s/\175//;  # 173 is octal left curly brace 175 is right
            s/&/\\&/g;
            print "<H2> $_</H2>\n";
            $previous_line=3;
            next;
        }
        # }}}
        # {{{  Start of choir                 
        if (/{soc.*}/ or /{start_of_chorus.*}/) {
            $it="<i>";
            #print "<it>\n";
            next;
        }
        # }}}
        # {{{  End of choir                   
        if (/{eoc.*}/ or /{end_of_chorus.*}/) {
            $it="";
            #print "\\rm\n";
            next;
        }

        # }}}
        # {{{  Comment                        
        if (/{c:.*}/ or /{comment:.*}/) {
            s/\173[^:]*: *//; s/\175//;  # 173 is octal left curly brace 175 is right
            s/&/\\&/g;

            # {{{ Care about previous block
            if ($previous_block!=0) {
                print "<br>\n"   if ($previous_block==1);
                print "<br><br>\n" if ($previous_block==2);
                $previous_block=0;
            }
            # }}}

            print "<i>$_</i><br>\n";
            $previous_line=1;  #Comment is close to ordinary text
            next;
        }

        # }}}
        # {{{  Other command                  
        if (/{.*}/) {next;}
        # }}}

        # {{{  Comment (programmer's kind of) 
        if (/^\043/) {    # 043 is octal of hash
            next; }
        # }}}
        # {{{  Chord instructions             

        if (/\[[^:]/) {
            $_.=" ";

            # {{{ Care about previous block      
            if ($previous_block!=0) {
                print "<br><br>\n"    if ($previous_block==1);
                print "<br><br><br>\n"  if ($previous_block==2);
                $previous_block=0;
            }
            # }}}
            # {{{ Ensure chords contain no spaces
            if (/\[[^\x5d]* [^\x5d]*\]/) {
                warning "\nSetchord: Chords cannot contain spaces.\n";
                warning "This was broken at file $ARGV:\n";
                warning $_;
                exit; }
            # }}}

            s/&/&amp;/g;                  #care about html-dangerous characters

            s/\]\[/\] \[/g;             #no chords tightly follow

            s/\] /\]&nbsp; /g;          #chord is preshifted to the left of the text

            my @text   = find_text($_);
            my @chords = find_chords($_);

            # {{{ Print tab stops for chords and chords

            my $chord_line="<tr><td>";
            my $text_line="<tr><td>$it$text[0]";
            my $textpos=1;
            for (@chords) {
                $crd = set_one_chord_html("$_");
                $chord_line.="</td><td>$crd";
                $text_line.="</td><td>$it$text[$textpos]";
                
                $textpos++;
            }
            $chord_line.="</td></tr>\n";
            $text_line.="</td></tr>\n";


            print "<table border=0 cellpadding=0 cellspacing=0>\n";
            print "$chord_line";
            print "$text_line";
            # }}}

            print "</table>\n";
            $previous_line=2;
            next; }
        # }}}
            
        # {{{  Spaces only                    
        if (/^ *$/) {
            $previous_block=$previous_line if ($previous_line!=0);
            $previous_line=0;
            next; }
        # }}}
        # {{{  Text without chords            
        do {
            # {{{  Care about previous block     
        if ($previous_block!=0) {
            print "<br>\n"   if ($previous_block==1);
            print "<br><br>\n" if ($previous_block==2);
            $previous_block=0; }
        # }}}

            print "$_<br>\n";
            $previous_line=1; }
        # }}}
    }

    print "</html>\n";
    exit; }
# }}}
# {{{  transpose                        

if ($task eq "transpose") {
    $transposition=shift @ARGV;
    @tpose=<>;

    transpose($transposition);

    for (@tpose) {
	print; }
    exit; }

# }}}
# {{{  unknown                          
print STDERR "Task \"$task\" is unknown.\n".$help_message;
exit;
# }}}

if ($stdout_opened) {
    close (STDOUT); }

# {{{  emacs                            
#
# Local Variables:
# compile-command:"chordpack tex chordpack-testing-song.pro >testing.tex"
# compile-function:(save-excursion (compile compile-command)(sleep-for 2)(to-buffer "testing.tex")(TeX-compile-to-ps))
# end:
#
# }}}














