#!/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 =
'
Some Rights Reserved: CC-by-nc-sa/4.0
';
$CCnotice =
'
$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 .
}
### 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);
}
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 "\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 .
}
### End a bridge:
sub endBridge {
endChorus(1);
if ($html) { print "" 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 "\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 .= |