#!/usr/bin/perl # $Id: flktran.pl,v 1.15 2010-10-14 06:48:15 steve Exp $ # flktran [options] infile outfile # Perform format translation on filksong files. # ChordPro: TODO # split (Key\capoN) into {key Key} and {capo N} # handle {chorus} and similar inline metadata ### Print usage info: sub usage { print "$0 [options] infile[.flk] [outfile].ext\n"; print " -b -bare bare lyrics -- no headings\n"; print " -c -chords output chords\n"; print " -h -html output html\n"; print " -n -dryrun no action (dry run)\n"; print " -t -tables use tables (implies -h -c)\n"; print " -v verbose\n"; print " Formats (extensions): \n"; print " cho ChordPro (also chord, chordpro, or cpro)\n"; print " flk FlkTeX (input; default)\n"; print " html HTML\n"; print " tex LaTeX -- sources .flk file\n"; print " txt plain text (default)\n"; } ### Option variables and their defaults: $infmt = "flk"; $infile = ""; $outfmt = "txt"; $outfile = ""; $doctype = ""; # document type (LaTeX or SGML) $options = ""; # LaTeX style options $tables = 0; # use tables for HTML? $verbose = 0; $chords = 0; $dryrun = 0; ### Adjustable parameters: $TABSTOP = 4; # tabstop for indented constructs $WIDTH = 72; # line width for centering ### Variables set from environment: $WEBSITE = $ENV{'WEBSITE'}; $WEBDIR = $ENV{'WEBDIR'}; $WEBDIR =~ s|/$||; ### State variables: $indent = 0; # current indentation level $plain = 0; # true when inside plain (non-chorded) text $chorus = 0; # true inside a chorus or bridge $verse = 0; # number of verses seen so far $vlines = 0; # the number of lines in the current verse or chorus $plines = 0; # the number of lines in the current text block $header = 0; # true after header done. $verbatim = 0; # true inside a verbatim environment --
in html ### Variables set from song macros: $bare = ""; $title = ""; $subtitle = ""; $notice = ""; $license = ""; $dedication = ""; $tags = ""; $key = ""; $timing = ""; $created = ""; $cvsid = ""; $music = ""; $lyrics = ""; $arranger = ""; ### Handle options: if (@ARGV == 0) { usage; exit } while ($ARGV[0] =~ /^\-/) { if ($ARGV[0] eq "-b" || $ARGV[0] eq "-bare") { shift; $bare = 1; } elsif ($ARGV[0] eq "-c"|| $ARGV[0] eq "-chords") { shift; $chords = 1; } elsif ($ARGV[0] eq "-h" || $ARGV[0] eq "-html") { shift; $html = 1; } elsif ($ARGV[0] eq "-t"|| $ARGV[0] eq "-tables") { shift; $tables = 1; $chords = 1; $html = 1; } elsif ($ARGV[0] eq "-v"|| $ARGV[0] eq "-verbose") { shift; $verbose = 1; } elsif ($ARGV[0] eq "-n"|| $ARGV[0] eq "-dryrun") { shift; $dryrun = 1; } else { usage; die "unrecognized option $1\n"; } } if ($ARGV[0]) { $infile = shift; } if ($ARGV[0]) { $outfile= shift; } if ($infile !~ /\./) { $infile .= ".flk"; } if ($html) { $outfmt = "html"; } # If $outfile ends in /, it's a directory. In that case, the output # goes into the corresponding directory, in a file called lyrics.html if ($outfile =~ /\.html$/) { $outfmt = "html"; $html = 1; } if ($outfile =~ /\.c(h|pr)o[a-z]*$/) { $outfmt = "cpro"; $cpro = 1; $chords = 1; } if ($outfile && $outfile !~ /\./ && $outfile !~ /\/$/ && $outfmt) { $outfile .= ".$outfmt"; } # The extension-handling and name-handling stuff is a mess, but we'll save # any major changes for the grand refactoring. Right now we just want # to be able to handle ChordPro $html = $outfmt eq "html"; $tables = 0 unless $html; $outfile =~ s|/lyrics.html$|/|; $outfile =~ s/^\.[a-z]+$//; # just an extension: output goes to stdout if ($outfile =~ m|^(.*/)?([^/]+)(\.[^./]+)$|) { $filebase = "$2"; $filedir = ($1 eq "")? "." : $1; $shortname= $2; $extension= $3; # note that the extension includes the final "." $filename = "$2$3"; $htmlfile = "$filebase.html"; } elsif ($outfile =~ m|^(.*/)?([^/]+)/$|) { $filebase = "$2"; $filedir = "$1/$2"; $shortname= $2; $filename = "lyrics.html"; $htmlfile = "$filebase/"; $outfile = "$filedir/lyrics.html"; } if ($WEBSITE) { $WEBSITE =~ m|https?://([^/]+)|; $sitename = $1; } else { $sitename = ''; } if ($verbose) { print STDERR " infile=$infile; outfile=$outfile; format=$outfmt\n"; print STDERR " filedir=$filedir; filebase=$filebase; htmlfile=$htmlfile\n"; print STDERR " html=$html; tables=$tables; cpro=$cpro; plain=$plain\n"; } if ($dryrun) { exit 0; } if ($infile) { open(STDIN, $infile); } if ($outfile) { open(STDOUT, ">$outfile"); } ### Formatting constants: # After the refactoring, these ought to end up as hash keys if ($html) { $EM = ""; $_EM = ""; $BF = ""; $_BF = ""; $TT = ""; $_TT = "
"; $UL = ""; $_UL = ""; $PRE = ""; $_PRE= ""; $QUOTATION = " "; # sometimes used for indent inside spoken text $_QUOTATION = ""; $SPOKEN = $EM . "(spoken) "; $_SPOKEN = $_EM; $SUBSEC = ""; $_SUBSEC = "
"; $SUBSUB = ""; $_SUBSUB = "
"; $NL = "
\n"; $NP = "
\n"; $SP = " "; $AMP = "&"; # it might be more sensible to use the cellpadding to space the verses. $BVERSE = ($tables)? "
"
: "\n"; $EVERSE = ($tables)? " |
flktran
";
# Creative Commons copyright notice
$SomeRightsReserved =
'$WEBSITE/$WEBDIR/$htmlfile";
print "
\n";
print " Automatically generated with $FLKTRAN";
print " from $infile
.
\n";
if ($cvsid) { print " $cvsid\n"; }
print "
\n"; } if ($cpro) { if ($content =~ /^(refrain|chorus)$/i) { indentLine('{chorus', $TABSTOP); } else { indentLine("{comment_italic: $content", $TABSTOP); } print "}" } else { indentLine($content, $TABSTOP); } print "\n"; if ($html) { print "\n"; } } ### Handle a tailnote # DEPRECATED: use \begin{note}...\end{note} for notes containing begin/end blocks sub doTailnote { if ($vlines) {endVerse(); } if ($html) { print "
\n"; } indentLine(getContent($_, 0) . "\n"); $plines = 0; $plain ++; } ### Begin a chorus: sub begChorus { my ($isBridge) = @_; my $cssClass = $isBridge? "bridge" : "chorus"; if ($vlines) { endVerse(); } print "\n"; if ($html) { print "
\n" if ($tables); } if ($cpro) { print "{start_of_$cssClass}\n"; # chordpro (the reference implementation) treats a bridge just like a verse # so we add a comment to distinguish it. print "{comment_italic: bridge:}\n" if ($isBridge); } $indent += $TABSTOP; $chorus ++; # Note that begVerse will get called when the first line appears, # so we don't have to deal with verse count, line count, or\n" if ($tables); } if ($cpro) { endVerse(); print "{end_of_$cssClass}\n"; } print "\n"; $vlines = 0; $chorus --; $indent -= $TABSTOP; } ### Begin a bridge: sub begBridge { begChorus(1); if ($html) { print ". } ### End a chorus: # (also called a refrain; that usage is being phased out.) sub endChorus { my ($isBridge) = @_; my $cssClass = $isBridge? "bridge" : "chorus"; if ($html) { endVerse(); print "
\n" if ($tables); } $indent += $TABSTOP; # Note that begVerse will get called when the first line appears, # so we don't have to deal with verse count, line count, or" if ($tables); } print "\n"; $vlines = 0; $indent -= $TABSTOP; } ### Begin a note: sub begNote { if ($vlines) { endVerse(); } if ($html) { # We used to try to set this in a smaller font, but you can't # nest paragraphs (block elements) inside of a (inline element); } $plines = 0; $plain ++; } ### End a note: sub endNote { if ($html) { # We used to try to set this in a smaller font, but you can't # nest paragraphs (block elements) inside of a (inline element); } $plines = 0; $plain --; } ### Begin a quote: sub begQuote { if ($vlines) { endVerse(); } $plines = 0; $plain ++; if ($html) { print ". } ### End a bridge: sub endBridge { endChorus(1); if ($html) { print "
\n"; } $indent += $TABSTOP; } ### End a quote: sub endQuote { $plines = 0; $plain --; $indent -= $TABSTOP; if ($html) { print "\n"; } } ### Begin a verbatim section: sub begVerbatim { print $PRE; $verbatim ++; } sub endVerbatim { print $_PRE; $verbatim --; } ######################################################################## ### ### Block conversion: ### ### Each of these routines converts the start or end of a ### delimited block of lines to output format. ### sub doHeader { $header ++; if ($bare) { return; } if ($html) { htmlHeader(); } elsif ($cpro) { cproHeader(); } else { textHeader(); } } sub center { # === need to handle multiple lines === my ($text) = @_; $text =~ s/^[ \t]*//; $text =~ s/[ \t]*\n$//; $text =~ s/\\copyright/Copyright/; $text =~ s/[Ss]ome [Rr]ights [Rr]eserved\.?/$SomeRightsReserved/gs; $text =~ s/\\SomeRightsReserved/$SomeRightsReserved/gs; $text =~ s/\\CcByNcSa/$CCNotice/gs; my $w = $WIDTH - length($text); for ( ; $w > 0; $w -= 2) { $text = " " . $text; } print "$text\n"; } sub hcenter { my ($h, $text) = @_; $text =~ s/^[ \t]*//; $text =~ s/\\copyright/\©/; $text =~ s/\n/\
before
\n"; } else { print "\n"; } } $_ = deTeX($_); if ($html) { s/\~/ /g; } else { s/\~/ /g; } s/\\newline/$NL/g; s/\\\///g; indentLine($_, $indent); $plines ++; } else { if ($vlines == 0) { begVerse(); } if ($tables) { print tableLine($_); } else { print chordLine($_); } $vlines ++; } } ### Put out a plain line, possibly indented. sub indentLine { my ($line, $indent) = @_; $line =~ s/^[ \t]*//; while ($indent--) { $line = " ".$line; } print $line; } ### Convert an ordinary line to chords + text # === does not insert indent yet. sub chordLine { my ($line) = @_; # input line my $cline = ""; # chord line my $dline = ""; # dest. (text) line my ($scol, $ccol, $dcol, $inchord, $inmacro) = ($indent, 0, 0, 0, 0); my $c = ''; # current character my $p = 0; # current position $line = deTeX($line); $line =~ s/^[ \t]*//; $line =~ s/\\sus/sus/g; $line =~ s/\\min/m/g; $line =~ s/\\maj/maj/g; if ($cpro) { return $line; } for ($p = 0; $p < length($line); $p++) { $c = substr($line, $p, 1); if ($c eq "\n" || $c eq "\r") { break; } if ($c eq '[') { $inchord ++; } elsif ($c eq ']') { $inchord --; } elsif ($c eq ' ') { if (!$inchord) { $scol ++; } } elsif ($c eq "\t") { if (!$inchord) { do {$scol ++; } while ($scol % 8); } } else { if ($inchord) { while ($ccol < $scol) { $cline .= ' '; $ccol ++ } $cline .= $c; $ccol ++; } else { while ($dcol < $scol) { $dline .= ' '; $dcol ++ } $dline .= $c; $dcol ++; $scol++; } } } # The result has a newline appended to it. return (($cline && $chords)? $cline . "\n" . $dline : $dline); } ### Convert a line to a table ### When using tables, each line becomes a separate table containing chords and text. ### This, in turn, becomes a row in a table containing the verse. sub tableLine { my ($line) = @_; # input line my $cline = ""; # chord line my $dline = ""; # dest. (text) line my ($scol, $ccol, $dcol, $inword, $inchord, $inmacro) = ($indent, 0, 0, 0, 0, 0); my $c = ''; # current character my $p = 0; # current position $line = deTeX($line); $line =~ s/^[ \t]*//; $line =~ s/[\n\r]//g; # the following may be redundant if handled in deTeX $line =~ s/\\sus/sus/g; $line =~ s/\\min/m/g; $cline .= "
cells.
while ($txt =~ /\{\\(em|tt|bf|)[ \t\n]/
|| $txt =~ /\\(ul|underline|link|subsection|subsubsection)\{/
|| $txt =~ /\\(emph|spoken|quotation)\{/
|| $txt =~ /\\(subsection|subsubsection)\*[^\{]*\{/
|| $txt =~ /\\(hskip)/
) {
my $tag = $1;
if ($tables && ($tag =~ /(em|bf|tt)/) && $txt =~ /\{\\$tag[^\}\[]*\[/) {
# we have a chord before the end of the block. Split.
# em, bf, and tt all split the same way
$txt =~ s/(\{\\$tag[^\[]*)(\[[^\]]*\])/$1\}$2\{\\$tag /;
# If there's a space in front of the chord, keep it there, because
# tableLine turns a space before a chord into
$txt =~ s/([ \t])\}/}$1/;
}
if ($tag eq "em") {
$txt =~ s/\{\\em[ \t\n]/$em/;
$txt =~ s/\}/$_em/;
}
if ($tag eq "emph") { # italicize, but has the form \tag{...} Does't handle chords
$txt =~ s/\\emph\{/$em/;
$txt =~ s/\}/$_em/;
}
if ($tag eq "spoken") { # italicize, but has the form \tag{...} Does't handle chords
$txt =~ s/\\spoken\{/$SPOKEN/;
$em = "";
$_em = "";
$txt =~ s/\}/$_SPOKEN/;
}
if ($tag eq "quotation") { # quotation in the form \tag{...}
# used sometimes to get a paragraph indent inside of "spoken"
$txt =~ s/\\quotation\{/$QUOTATION/;
$txt =~ s/\}/$_QUOTATION/;
}
if ($tag eq "tt") {
$txt =~ s/\{\\tt[ \t\n]/$TT/;
$txt =~ s/\}/$_TT/;
}
if ($tag eq "bf") {
$txt =~ s/\{\\bf[ \t\n]/$BF/;
$txt =~ s/\}/$_BF/;
}
if ($tag eq "ul" || $tag eq "underline") {
# want to be able to handle underline{}
if ($tables && ($txt =~ /\\$tag\{[^\}\[]*\[/)) {
# we have a chord before the end of the block. Split.
$txt =~ s/(\\$tag\{[^\}\[]*)(\[[^\]]*\])/$1\} $2\\$tag\{/;
}
$txt =~ s/\\$tag\{/$UL/; # ul and underline have the same replacement text
$txt =~ s/\}/$_UL/;
$txt =~ s/$UL *$_UL//; # remove empty underline elements
}
if ($tag eq "link") {
while ($txt !~ /\\link\{[^\}]*\}\{[^\}]*\}/) { $txt .= |