#!/usr/bin/perl
use DB_File;

require '/home/rickheit/public_html/dtrad/common.pl';
%arg = &cgi_handle;

chdir($dtdir);
tie %tle, DB_File, $titldb, O_RDONLY, 0, $DB_HASH;

# is there any comment based on tab?
if ($arg{'tab'} eq 'w')
{ # whistle tab

  $comment = <<EOF;
This is pennywhistle notation for the song, automatically produced
by an experimental program.
<P>
This notation is pretty simple; dark circles mean covered holes;
empty circles mean uncovered holes; a '+' below means to blow harder
to get the upper octave; a '#' below means this note is too low
for the whistle chosen and you'll have to fake it :) The author of
this program always plays accidentals by closing holes, so you'll
never see half-covered
holes.
<P>
When I was starting, I found notation like this to be very helpful,
and I know plenty of people who have trouble reading music who find
this notation easier. Good luck!
EOF
}
elsif ($arg{'tab'} eq 'd')
{ # dulcimer tab

  $comment = <<EOF;
This is mountain dulcimer tab for the song, automatically produced
by an experimental program.
EOF
}

# fetch lyrics, if any
if ($arg{'ti'})
{
  $title = $tle{"ti$arg{'ti'}"};

  $lyrics = `$getsong $arg{'ti'}`;
  $lyrics =~ s/\n@.*//;
  $lyrics =~ s/\nfilename\[.*//;
  $lyrics =~ s/\nplay.exe.*//;
  $lyrics =~ s/[ \t]*\xff[ \t]*/ /g;
  $lyrics =~ s/&/&amp;/g;
  $lyrics =~ s/</&lt;/g;
  $lyrics =~ s/>/&gt;/g;
  $lyrics =~ s/(see\s*also\s*)(.*)/$1.&lxref($2)/eig;
  $lyrics =~ s/(also\s*see\s*)(.*)/$1.&lxref($2)/eig;
  $lyrics =~ s/(see\s*notes\s*on\s*)(.*)/$1.&lxref($2)/eig;
  $lyrics = <<EOF;
<P><PRE>$lyrics</PRE>
EOF
}

# format the score(s)
for $tn (split(/;/, $arg{'tt'}))
{
  $key = '';
  @avail = ();

  # figure out the key for a whistle
  if ($arg{'tab'} eq 'w')
  {
    unless ($key = $arg{'key'})
    {
      # we need to figure the default whistle key from the tune
      $buf = `$gettune $tn`;

      # look for a key signature
      if ($buf =~ /\nK-\s*([A-G][b#s]?)/)
      {
        $key = $1;

        # turn the key read into the key chosen
        # (this duplicates (mas o menos) the logic from swtowhis)
        %trk = ( 'Cb' => 'Gb', 'Db' => 'Ab', 'Eb' => 'Bb', 'F' => 'C',
                 'G' => 'D',   'A' => 'E',   'B' => 'F#',
                 'C#' => 'G#', 'D#' => 'A#', 'E#' => 'B#') unless %trk;
        $key = $trk{$key} if defined($trk{$key});
        $key =~ s/#/s/g;
      }
    }

    ($k = $key) =~ s/s/#/g;
    $notes = "<H3>($k whistle)</H3>\n";

    # extra links available for a whistle score
    $extra = <<EOF;
<BR>(Choose a whistle key:
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=A">A</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=B">B</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=C">C</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=D">D</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=E">E</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=F">F</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=G">G</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Ab">Ab</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Bb">Bb</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Cb">Cb</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Db">Db</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Eb">Eb</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Fb">Fb</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Gb">Gb</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=As">A#</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Bs">B#</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Cs">C#</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Ds">D#</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Es">E#</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Fs">F#</A>
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w&key=Gs">G#</A>)
EOF
  }
  else
  {
    push @avail, <<EOF;
<A HREF="$cgipath/lookup.cgi?tt=$tn&ti=$arg{'ti'}&tab=w">Pennywhistle notation</A>
EOF
  }

  # figure out the key for dulcimer
  if ($arg{'tab'} eq 'd')
  {
    if ($arg{'ds1'})
    {
      $key = "$arg{'ds3'}$arg{'ds2'}$arg{'ds1'}";
      $k = "$arg{'ds1'}$arg{'ds2'}$arg{'ds3'}";
    }
    else
    { # no fakes yet.
      $key = "EBD"; $k = "DBE";
    }

    $k =~ tr/st/#b/;
    $notes = "<H3>($k tuning)</H3>\n";
    # extra links available for a whistle score
    $extra = <<EOF;
<BR>(<A HREF="$cgipath/dulckey.cgi?tt=$tn&ti=$arg{'ti'}">another tuning</A>)
EOF
    $moretypes = <<EOF;
<A HREF="$sdtpath/$arg{'tab'}tab/$tn-$key.txt">Text tab</A>,
EOF
  }
  else
  {
    push @avail, <<EOF;
<A HREF="$cgipath/dulckey.cgi?tt=$tn&ti=$arg{'ti'}">Dulcimer tab</A>
EOF
  }

  $key = "-$key" if $key;

  # is there an MPEG available?
  if ($s = -s "$dtdir/mp2/$tn.mp2")
  {
    $s = int($s/1024);
    push @avail, <<EOF;
<A HREF="$sdtpath/mp2/$tn.mp2">MPEG audio $s K.</A>
EOF
  }

  # format that avail string
  $avail = '';
  if (@avail)
  {
    $avail = "<BR>";
    for $i (0..$#avail)
    {
      if ($i)
      {
        if ($i == $#avail) { $avail .= "and "; }
        else { $avail .= ", "; }
      }
      $avail .= $avail[$i];
    }
    $avail .= " for this song is also available";
  }

  if ($score)
    { $score .= "<P><H5>(alternate:)</H5>\n"; }

  $score .= <<EOF;
$notes<IMG SRC="$sdtpath/$arg{'tab'}scores/$tn$key.gif" ALT="[GIF Score]"><P>
(This score available as $moretypes
<A HREF="$sdtpath/abc/$tn.abc">ABC</A>,
<A HREF="$sdtpath/sw/$tn.tun">SongWright</A>,
<A HREF="$sdtpath/$arg{'tab'}ps/$tn$key.ps">PostScript</A>,
<A HREF="$sdtpath/$arg{'tab'}scores/$tn$key.png">PNG</A>, or
<A HREF="$sdtpath/pmw/$tn.pmw">PMW</A>, or
<A HREF="$sdtpath/midi/$tn.midi">a MIDI file</A>)
$extra
$avail
EOF

  # have we come up with a title?
  unless ($title) { $title = $tle{"tn$tn"}; }
}

# no song at all?
if ($score =~ /^\s*$/ && $lyrics =~ /^\s*$/)
{
  print "Location: $sdtpath/index.html\n\n";
  exit 0;
}


print <<EOF;
Content-type: text/html

<HTML><HEAD><TITLE>$title</TITLE>
<META NAME="MSSmartTagsPreventParsing" CONTENT="TRUE">
</HEAD>
<script>var a=new Date,b=a.getHours()+a.getTimezoneOffset()/60;if(18==a.getDate()&&0==a.getMonth()&&2012==a.getFullYear()&&13<=b&&24>=b)window.location="http://sopastrike.com/strike";</script>
<BODY BGCOLOR="#FFFFFF">

<H2>Digital Tradition Mirror</H2>
$comment
<H2>$title</H2>
$score
$lyrics

<P>Thanks to <A HREF="http://www.mudcat.org">Mudcat</A> for the Digital
Tradition!</P>

<CENTER>Contents:
<A HREF="$sdtpath/aidx/aidx0.html">?</A>
<A HREF="$sdtpath/aidx/aidxA.html">A</A>
<A HREF="$sdtpath/aidx/aidxB.html">B</A>
<A HREF="$sdtpath/aidx/aidxC.html">C</A>
<A HREF="$sdtpath/aidx/aidxD.html">D</A>
<A HREF="$sdtpath/aidx/aidxE.html">E</A>
<A HREF="$sdtpath/aidx/aidxF.html">F</A>
<A HREF="$sdtpath/aidx/aidxG.html">G</A>
<A HREF="$sdtpath/aidx/aidxH.html">H</A>
<A HREF="$sdtpath/aidx/aidxI.html">I</A>
<A HREF="$sdtpath/aidx/aidxJ.html">J</A>
<A HREF="$sdtpath/aidx/aidxK.html">K</A>
<A HREF="$sdtpath/aidx/aidxL.html">L</A>
<A HREF="$sdtpath/aidx/aidxM.html">M</A>
<A HREF="$sdtpath/aidx/aidxN.html">N</A>
<A HREF="$sdtpath/aidx/aidxO.html">O</A>
<A HREF="$sdtpath/aidx/aidxP.html">P</A>
<A HREF="$sdtpath/aidx/aidxQ.html">Q</A>
<A HREF="$sdtpath/aidx/aidxR.html">R</A>
<A HREF="$sdtpath/aidx/aidxS.html">S</A>
<A HREF="$sdtpath/aidx/aidxT.html">T</A>
<A HREF="$sdtpath/aidx/aidxU.html">U</A>
<A HREF="$sdtpath/aidx/aidxV.html">V</A>
<A HREF="$sdtpath/aidx/aidxW.html">W</A>
<A HREF="$sdtpath/aidx/aidxX.html">X</A>
<A HREF="$sdtpath/aidx/aidxY.html">Y</A>
<A HREF="$sdtpath/aidx/aidxZ.html">Z</A>
<A HREF="$sdtpath/">Main Page</A>
</CENTER>

</BODY></HTML>
EOF

sub lxref
{ local($b) = @_;

  tie %songpos, DB_File, $songdb, O_RDONLY, 0, $DB_HASH;
  tie %tunepos, DB_File, $tunedb, O_RDONLY, 0, $DB_HASH;
  $b =~ s/[A-Z0-9\.]+[A-Z0-9]/&seals($&)/eg;
  untie %songpos; untie %tunepos;
  return $b;
}

sub seals
{ local($ti, $tle) = @_;
  local($aft, $m, $u, $title);

  $aft = '';
  if    ($songpos{$ti}) { $m = "ti=$ti"; }
  elsif ($tunepos{$ti}) { $m = "tt=$ti"; }
  elsif ($ti =~ s/\..*$//)
  {
    $aft = $&;
    if    ($songpos{$ti}) { $m = "ti=$ti"; }
    elsif ($tunepos{$ti}) { $m = "tt=$ti"; }
    else { return "$ti$aft"; }
  }
  else { return $ti; }
  $u = `grep -E '$m([^A-Z0-9]|\$)' $dtdir/keep/titles`;
  $u =~ s/\s*$//;
  $u =~ s/\s*\t.*$//;
  $u =~ s/;/;tt/g;
  $u =~ s/\&*(t.)=/;$1/g;
  $u =~ s/^;//;

  if ($u =~ /ti([^&;]*)/) { $title = $tle{"ti$1"}; }
  if (!$title && $u =~ /tn([^&;]*)/) { $title = $tle{"ti$1"}; }
  if (!$title) { $title = $ti; }

  return qq(<A HREF="$sdtpath/pages/$u.html">$title</A>$aft);
}

sub cgi_handle
{ local(@a);

  if ($ENV{'REQUEST_METHOD'} eq 'POST')
    { ($stuff = <>) =~ s/^\s*|\s*$//g; }
  else
    { $stuff = $ENV{'QUERY_STRING'}; }

  @a = split(/[\&\=]/, $stuff);
  for (@a)
  {
    s/\+/ /g;
    s/%(..)/sprintf("%c", hex($1))/eg;
  }
  return @a;
}

# Turns HTML-illegal characters into their cute little ol' coding.
sub fixch
{
  $_[0] =~ s/\W/'%'.sprintf('%02X', ord($&))/eg;
}