#!/usr/bin/perl

#
#  Copyright 2011-2013 Thomas A. Alspaugh.
#
#  This work is licensed under the
#  Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License.
#  To view a copy of this license, visit
#  http://creativecommons.org/licenses/by-nc-sa/3.0/
#  or send a letter to Creative Commons, 444 Castro Street, Suite 900,
#  Mountain View, California, 94041, USA.
#
#  Attribution requirements for this file are listed at
#  http://www.thomasalspaugh.org/pub/attribution-by-nc-sa.html
#

#  Timestamp 2013Feb17Su13:30


use strict;  use warnings;

my $cmdName = $0;

sub help {
  print STDERR <<HEREDOCUMENT
Works out the result of a list of call changes.
Input is a sequence of calls, read from a file named on the command line.  "--"
represents the standard input.
Each call is of the form FR-TO, where FR is a digit 0-9 (0 representing 10) and
TO is either a digit [0-9] or (for down-calls only) the letter "L" or the word
"lead".  The hyphen is optional.
Lines starting with a - are taken to give options as on the command line.
Blank lines and comments starting with # are ignored.
Output consists of a line for each change comprising
  the line number (1 through the number of changes) followed by a period
  the call, in the form "2 to 3" or "2 to lead"
  the resulting sequence of bells
  (if the sequence has a name) the name of the sequence:
    Rounds, Back Rounds, Queens, Tittums, Whittingtons.
Options:
  -help  Show this help.
  -a or -abbr     Show calls and row names in abbreviated form,
                  like 2-3 rather than "2 to 3" and "R" rather than "Rounds".
  -A or -Abbr     Show row names in abbreviated form,
                  like "R" rather than "Rounds".
  -d or -down     Input calls are down.
  -h or -html     Produce output as an HTML table.
  -H or -HTML     Produce output as a full HTML file.
  -n=N            Use N bells [default is 5].
  -R or -noRows   Do not show the row resulting from each call.
  -u or -up       Input calls are up [default].
  -0              (with -h or -H only) Show the initial row in rounds.
Output calls are in the same direction as input calls unless one of these
options is given:
  -D  or -Down    Output calls will be down only.
  -U  or -Up      Output calls will be up   only.
  -UD or -UpDown  Output calls will be given in both forms.
                  If -H or -HTML, each form is preceded by an up or down arrow.
For -html or -HTML,
  the line number           is in a  <span class='callNum'>, no period
  each down call            is in a  <span class='call callDn'>
  each up   call            is in a  <span class='call callUp'>
  the resulting sequence    is in a  <span class='row'>
  the name (possibly empty) is in a  <span class='rowName'>.
-HTML includes style for each of these classes.  In addition,
  -Hdir  If -H or -HTML, each call is preceded by an arrow (down or up),
         even if only one direction of output calls is produced.
HEREDOCUMENT
  ;
}

my $abbrCalls = "";
my $abbrNames = "";
my $fname = "";
my $fnameCount = 0;
my $html = "";
my $initialized = "";
my $inputDn = "";
my $inputArrow = "↑";
my $leadStr = "lead";
my $numBells  = 5;
my $outputDn = "";
my $outputUp = "y";
my $outputArrow = "↑";
my @row = ();       #  Leads is row[0], 2nds is row[1], etc.
my $rowName = "";
my $rowStr = "";
my $showArrows = "";
my $showRow0 = "";
my $showRows = "y";
my $vv = "";


my $arg = "";
for $arg (@ARGV) {
  if ($arg eq "--") {
    $fname = "<stdin>";
    *HIN = *STDIN;
    &perfile();
    ++$fnameCount;
  }
  elsif ($arg =~ /^-/) {
    &option($arg);
  }
  else {
    $fname = $arg;
    if (open HIN, "<$fname") {
      &perfile();
      close HIN;
    }
    else {
      die "($cmdName)  Can't open input file $fname.\n";
    }
    ++$fnameCount;
  }
}

if (0 == $fnameCount) {
  &help();
}


#  Deal with the option given as the first parameter.
sub option {
  my $arg = $_[0];
  if    ($arg =~  /^-+help$/) {
    &help;
    exit(0);
  }
  elsif ($arg =~  /^-+a(bbr(eviated)?)?$/) {
    $abbrCalls = "Y";
    $abbrNames = "Y";
  }
  elsif ($arg =~  /^-+A(bbr(eviated)?Names)?$/) {
    $abbrNames = "Y";
  }
  elsif ($arg =~  /^-+d(own)?$/) {
    $inputDn  = "Y";
    $inputArrow = "↓";
    if ("Y" ne $outputUp) {
      $outputDn = "Y";
      $outputUp = "";
      $outputArrow = "↓";
    }
  }
  elsif ($arg =~  /^-+D(own)?$/) {
    $outputDn = "Y";
    $outputUp = "";
    $outputArrow = "↓";
  }
  elsif ($arg =~  /^-+H(TML)?$/) {
    $html = "Y";
  }
  elsif ($arg =~  /^-+h(tml)?$/) {
    $html = "y";
  }
  elsif ($arg =~  /^-+Hdir$/) {
    $showArrows = $arg;
  }
  elsif ($arg =~  /^-+n=([0-9]+)$/) {  $numBells = $arg;
    $numBells =~ s/^-+n=([0-9]+)$/$1/;
    if (10 < $numBells) {
      die "“$arg”:  Only up to 10 bells are allowed.\n";
    }
  }
  elsif ($arg =~  /^-+(noRows|R)$/) {
    $showRows = "";
  }
  elsif ($arg =~  /^-+u(p)?$/) {
    $inputDn  = "";
    $inputArrow = "↑";
    if ("Y" != $outputDn) {
      $outputDn = "";
      $outputUp = "Y";
      $outputArrow = "↑";
    }
  }
  elsif ($arg =~  /^-+U(p)?$/) {
    $outputDn = "";
    $outputUp = "Y";
    $outputArrow = "↑";
  }
  elsif ($arg =~  /^-+U(p)?D(own)?$/) {
    $outputUp = "Y";
    $outputDn = "Y";
    $outputArrow = "↕";
  }
  elsif ($arg =~  /^-+v$/) {
    $vv = "y";
  }
  elsif ($arg =~  /^-+0$/) {
    $showRow0 = "y";
  }
  else {
    die "Unexpected option “$arg”.\n";
  }
}


sub perfile {
  #  The two bells mentioned in the call
  my $b1 = "";
  my $b2 = "";
  #  The bells involved in the call were in sequence $bA $bB $bC.
  #  Down-call "$bC to $bA"  is equivalent to up-call   "$bB to $bC"
  #  Down-call "$bC to lead" is equivalent to up-call   "$bB to $bC"
  #  Up-call   "$bB to $bC"  is equivalent to down-call "$bC to $bA"
  #                                        or down-call "$bC to lead"
  my $bA = "";
  my $bB = "";
  my $bC = "";

  my $callStrDn = "";
  my $callStrPad = "   ";
  my $callStrUp = "";
  my $j = 0;
  my $n = 0;
  my $nPfx = "";
  my $numBellsA = (10 == $numBells ? "0" : "$numBells");
  @row = ();
  $rowName = "";
  $rowStr = "";

  while (<HIN>) {
    chomp;
    s/#.*$//;
    s/ +$//;
    if (!$_ || /^#/) {  next;  }
    if (!$initialized) {
      if (/^-/) {
        &option($_);
        next;
      }
      &init;
    }
    ++$n;
    $nPfx = ($n < 10 ? " " : "");
    if    (   /^([0-9])-?(L|lead)$/) {  $b1 = $_;
      $b1 =~ s/^([0-9])-?(L|lead)$/$1/;
      if (!$inputDn) {
        die "[$nPfx$n.]  “$b1 to lead”:  Up-calls cannot call to lead\n";
      }
      if ($b1 eq "0" || $b1 <= $numBells) { }
      else {
        die "[$nPfx$n.]  “$b1 to lead”:  $b1 is not in 1-$numBellsA\n";
      }
      if ($vv) {  print STDERR "<$nPfx$n.> $inputArrow$b1 to lead\n";  }
      $bA = "L";
      $bB = $row[0];
      $bC = $row[1];
      if ($b1 == $row[1]) {
        $row[1] = $bB;
        $row[0] = $bC;
      }
      else {
        die "[$nPfx$n.]  “$b1 to lead”:  $b1 is not in 2nds:\n$rowStr\n";
      }
    }
    elsif (   /^([0-9])-?([0-9])$/) {  $b1 = $_;  $b2 = $_;
      $b1 =~ s/^([0-9])-?([0-9])$/$1/;
      $b2 =~ s/^([0-9])-?([0-9])$/$2/;
      if ($b1 eq "0" || $b1 <= $numBells) { }
      else {
        die "[$nPfx$n.]  “$b1 to $b2”:  $b1 is not in 1-$numBellsA\n";
      }
      if ($b2 eq "0" || $b2 <= $numBells) { }
      else {
        die "[$nPfx$n.]  “$b1 to $b2”:  $b2 is not in 1-$numBellsA\n";
      }
      if ($vv) {  print STDERR "<$nPfx$n.> $inputArrow$b1 to $b2\n";  }
      if ($inputDn) {
        for ($j = 0;  $j < $numBells-2;  ++$j) {
          if ($row[$j] == $b2) {
            if ($row[2+$j] != $b1) {
              die "[$nPfx$n.]  ↓“$b1 to $b2”:  $b1 is not two after $b2:\n$rowStr\n";
            }
            $bA = $row[$j];
            $bB = $row[$j+1];
            $bC = $row[$j+2];
            $row[$j+1] = $bC;
            $row[$j+2] = $bB;
            last;
          }
        }
      }
      else { # input up
        for ($j = 0;  $j < $numBells-1;  ++$j) {
          if ($row[$j] == $b1) {
            if ($row[1+$j] != $b2) {
              die "[$nPfx$n.]  ↑“$b1 to $b2”:  $b2 is not one after $b1:\n$rowStr\n";
            }
            $bA = (0 < $j ? $row[$j-1] : "lead");
            $bB = $row[$j];
            $bC = $row[$j+1];
            $row[$j  ] = $bC;
            $row[$j+1] = $bB;
            last;
          }
        }
      }
    }
    else {
      die "[$nPfx$n.]  Unrecognized call “$_”.\n";
    }
    if ($vv) {  print STDERR "    $bA · $bB · $bC\n";  }
    $callStrPad = ("L" eq $bA && $outputDn ? "" : "   ");
    if ("L" eq $bA) {  $bA = $leadStr;  }
    $callStrDn = ($abbrCalls ? "$bC-$bA" : "$bC to $bA");
    $callStrUp = ($abbrCalls ? "$bB-$bC" : "$bB to $bC");
    &makeRowStrAndName;
    if ($html) {
      my $callTd = "";
      if    ($outputUp && $outputDn) {
        $callTd =
                "<td class='call'>\n" .
            "      <span class='call callUp'>$callStrUp</span>\n" .
            "      <span class='call callDn'>$callStrDn</span>\n" .
            "    </td>";
      }
      elsif ($outputUp) {
        $callTd = "<td class='call'><span class='call callUp'>$callStrUp</span></td>";
      }
      else {
        $callTd = "<td class='call'><span class='call callDn'>$callStrDn</span></td>";
      }
      print <<HEREDOCUMENT
    <tr>
      <td class='callNum'><span class='callNum'>$n</span></td>
      $callTd
HEREDOCUMENT
      ;
      if ($showRows) {
        print <<HEREDOCUMENT
      <td class='row'><span class='row'>$rowStr</span></td>
HEREDOCUMENT
        ;
      }
      print <<HEREDOCUMENT
      <td class='rowName'><span class='rowName'>$rowName</span></td>
    </tr>
HEREDOCUMENT
      ;
    }
    else {
      my $callStr =
          ($outputUp ? $callStrUp . ($outputDn ? "“/”" : "") : "") .
          ($outputDn ? $callStrDn : "");
      print "[$nPfx$n.] “$callStr”";
      if ($showRows) {
        print "$callStrPad $rowStr";
        if ($rowName ) {  print " $rowName";  }
      }
      print "\n";
    }
  }

  if ($html) {
    print <<HEREDOCUMENT
  </tbody>
  </table><!--callChanges-->
HEREDOCUMENT
    ;
    if ($html eq "Y") {
      print <<HEREDOCUMENT

  </body>
  </html>

HEREDOCUMENT
      ;
    }
  }
}


#  Set $rowStr to the string version of @row.
#  Set $rowName to the name of the row, or "" if it has none.
sub makeRowStrAndName {
  $rowStr = "";
  my $j = "";
  for ($j = 0;  $j < $numBells;  ++$j) {
    $rowStr = $rowStr . ($row[$j] == 10 ? "0" : $row[$j]);
  }
  # print "### Making row string: $rowStr\n";
  if    ($rowStr =~ /^123(4(5(6(7(8(9a?)?)?)?)?)?)?$/) {
    $rowName = ($abbrNames ? "R" : "Rounds");
  }
  elsif ($rowStr =~ /^13(5(79?)?)?2(4(6(8a?)?)?)?$/) {
    $rowName = ($abbrNames ? "Q" : "Queens");
  }
  elsif ($rowStr =~ /^(((((((a?)?9)?8)?7)?6)?5)?4)?321$/) {
    $rowName = ($abbrNames ? "B" : "Back Rounds");
  }
  elsif ($rowStr =~ /^(((9?)?7)?5)?312(4(6(8a?)?)?)?$/) {
    $rowName = ($abbrNames ? "W" : "Whittingtons");
  }
  elsif ($rowStr =~ /^1324?$/      ||
         $rowStr =~ /^142536?$/    ||
         $rowStr =~ /^15263748?$/  ||
         $rowStr =~ /^162738495a?$/) {
    $rowName = ($abbrNames ? "T" : "Tittums");
  }
  else {
    $rowName = "";
  }
}

#  Initialize @row to rounds for $numBells.
sub rowInit {
  my $j = "";
  for ($j = 0;  $j < $numBells;  ++$j) {
    $row[$j] = 1+$j;
  }
}


sub init {
  # print "### init\n";
  &rowInit;
  &makeRowStrAndName;

  if ($html) {
    if ($html eq "Y") {
      print <<HEREDOCUMENT
  <!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.1//EN'
       'http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd'>
  <html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
  <head>
    <style type='text/css'>
      table.callChanges, table.callChanges td, table.callChanges th {  border: none;  }
      td.callNum, td.call, td.row {
        font-family: "Lucida Sans Typewriter", monospace;
      }
      td.rowName {
        font-family: "Gill Sans", sans-serif;
      }
      td.callNum {
        text-align: right;
      }
      td.callNum, td.row {
        font-size: 60%;
      }
      td.call, td.rowName {
        padding: 0 .67em;
      }
      span.callNum {
        vertical-align: -.3ex;
      }
      span.callNum:after {  content: ".";  }
HEREDOCUMENT
      ;
      if (!$abbrCalls) {
        print <<HEREDOCUMENT
      span.call:before   {  content: "\\201c";  }
      span.call:after    {  content: "\\201d";  }
HEREDOCUMENT
        ;
      }
      if ($showArrows) {
        print <<HEREDOCUMENT
      span.callDn:before   {  content: "\\2193 \\201c";  }
      span.callUp:before   {  content: "\\2191 \\201c";  }
HEREDOCUMENT
        ;
      }
      if ($outputDn && $outputUp) {
        print <<HEREDOCUMENT
      span.callUp:after   {  content: "\\201d\\00a0=";  }
HEREDOCUMENT
        ;
      }
      print <<HEREDOCUMENT
      span.lead:before {
        content: 'lead';
        text-transform: uppercase;
        font-size: 80%;
      }
      td.rowName {
        font-size: 80%;
      }
    </style>
    <script type='text/javascript' src='../../alspaugh-org.js'></script>
  </head>
  <body>

HEREDOCUMENT
      ;
    }
    print <<HEREDOCUMENT
  <table class='callChanges'>
  <tbody>
HEREDOCUMENT
    ;
  }

  if ($showRow0 && $showRows) {
    if ($html) {
      print <<HEREDOCUMENT
      <tr>
        <td class='callNum'><span class='callNum'>0</span></td>
        <td class='call'></td>
        <td class='row'><span class='row'>$rowStr</span></td>
        <td class='rowName'><span class='rowName'>$rowName</span></td>
      </tr>
HEREDOCUMENT
      ;
    }
    else {
      print <<HEREDOCUMENT
                  $rowStr $rowName
HEREDOCUMENT
      ;
    }
  }

  if (!$showArrows && $outputDn && $outputUp) {
    $showArrows = "UD";
  }

  if ($html && $abbrCalls) {
    $leadStr = "<span class='lead'></span>";
  }
  $initialized = "y";
}