#!/usr/bin/perl -w

use strict;
use Getopt::Long;
use Date::Convert::French_Rev;
use FindBin;
use constant DEBUG => 0;

my ($columns, $lang, $last, $example, $table_workaround) 
 = (       9,  'en',    400,    80218, 0);

GetOptions('columns=i'        => \$columns
        ,  'lang=s'           => \$lang
        ,  'example=s'        => \$example
        ,  'table-workaround' => \$table_workaround
       );
die "At least 5 colmuns" if $columns < 5;
die "The number of columns must be a multiple of 4 plus 1 (e.g. 5, 9 or 13)"
  unless $columns % 4 == 1;

--$columns; # because actually we do not want to be bothered with the heading column

# Because the  Gregorian leap day  may occur in  the middle of  a French
# Revolutionary year,  each F-R  year is divided  into two  parts: begin
# (Vendémiaire  to  mid-Ventôse)  and  end  (mid-Ventôse  to  additional
# days). The French Revolutionary leap  day is not a problem, it appears
# at  the  end of  the  year,  and therefore  has  no  influence on  the
# formulas.
my @parts = ('b', 'e');

# For each year and each part, we store the G day number of a specific F-R day.
# This specific day is
#      b => 1 Vendémiaire => ?? September
#      e => 1 Germinal    => ?? March
# We partially store the reverse : for each part or year and each G day number,
# which year can be taken as an sample.
my @day_of_yearpart;
my %year_of_partday;

# We fill the list of hashes, and the hash of hashes
foreach my $part (@parts)
  { day_of_yearpart($_, $part) foreach (1..$last) }


if (DEBUG)
  {
    for my $year (1 .. $last)
      {
        print ' ', day_of_yearpart($year, $_) foreach (@parts);
        print "\n" if $year % 4 == 3;
      }
    print "\n";
  }

# The tables do not contain the Sep-Mar day number, but a letter, which is easier
# to remember. So to each part - day number combination, we assign a letter.
# The ordering part then year is more pleasing than the other when reading 
# the final charts.
my $next_letter = 'a';
my %letter_of_partday  = ();
foreach my $part (@parts)
  {
    foreach (sort { $a <=> $b } keys %{$year_of_partday{$part}})
      {
        # print STDERR "$part $_ $next_letter\n";
        $letter_of_partday{$part}{$_} = $next_letter ++;
        ++$next_letter if $next_letter eq 'i'; # To prevent i<->j confusion
      }
  }

if (DEBUG)
  {
    for my $year (1 .. $last)
      {
        print ' ', $year, ' ', word_for_year($year);
        print "\n" if $year % 4 == 0
      }
    print "\n";
  }

# The year -> 2-letter word function is periodic, except for a few glitches
# each time the Gregorian or F-R century changes. So, years are grouped
# by four, eight, twelve or more each group is identified by a 8-, 16- or 
# 24-letter word. Interval are built so if two years n and n+4 (or n+8,
# or n+12) have the same formulas, they may belong to the same interval.
# If the formulas are different, the interval ends and a new interval
# begins.


my %line_for_interval;
my %end_of_interval;
build_intervals();

if (DEBUG)
  {
    print "$_ $end_of_interval{$_} $line_for_interval{$_}\n" 
       foreach (sort { $a <=> $b } keys %line_for_interval);
  }

# Some language-dependant variables are set in the "done" files.
# Therefore, they cannot be "my" variables, they must be global.
# I don't use "our", because it would break in older versions.

my $ref_labels;
if ($lang eq 'fr')
  { $ref_labels = do "$FindBin::Bin/labels_fr" }
else
  { $ref_labels = do "$FindBin::Bin/labels_en" }
my %labels = %$ref_labels;
my @fr_month = qw (Vendémiaire Brumaire Frimaire Nivôse   Pluviôse  Ventôse 
                   Germinal    Floréal  Prairial Messidor Thermidor Fructidor);
push @fr_month, "Sans-Culottides<br>$labels{add_days}";

html_1($labels{title1});
html_2($_) foreach (@parts);
print "<table><tr><td>\n" if $table_workaround;
usage($example);
print "</td></tr></table>\n" if $table_workaround;

#
# Gives the letter for a year and a part
# creating one if necessary
#
sub day_of_yearpart {
  my ($year, $part) = @_; # year: 1 to 400 or so, $part: b, e

  # memoized version
  return $day_of_yearpart[$year]{$part} if $day_of_yearpart[$year]{$part};

  # computed version
  my $month = $part eq 'b' ? 1 : 7;
  my $date =  new Date::Convert::French_Rev $year, $month, 1;
  convert Date::Convert::Gregorian $date;
  my $day = $date->day();
  # if no sample year yet, remember this one
  $year_of_partday{$part}{$day} = $year unless $year_of_partday{$part}{$day};
  $day_of_yearpart[$year]{$part} = $day;
}

sub word_for_year {
  my ($year) = @_;
  join '', map { letter_of_yearpart($year, $_) } @parts;
}

sub letter_of_yearpart {
  my ($year, $part) = @_;
  $letter_of_partday{$part}{$day_of_yearpart[$year]{$part}};
}

sub build_intervals {
  my $current_start = 1;
  %line_for_interval = (1 => '  ' x $columns);
  $end_of_interval{1}   = 4;

  foreach my $year (1..$last)
    {
      my $old_line = $line_for_interval{$current_start};
      my $new_line = '  ' x $columns;
      substr($new_line, $year % 100 % $columns * 2, 2) = word_for_year($year);
      my $intersection = $old_line & $new_line;
      $intersection =~ tr / /./;
      unless ($old_line =~ m{$intersection} && $new_line =~ m{$intersection})
        {
	  $current_start = $year;
	  $line_for_interval{$year} = $new_line;
	}
      $line_for_interval{$current_start} |= $new_line;
      $end_of_interval{$current_start} = $year;
  }
}

#
# Compute the formulas for a sample year and for a month.
# 1st Vendémiaire I is 22 September 1792, and 30 Vendémiaire I is 21 October I.
# Therefore, for Vendémiaire I, we have two formulas : "+21 Sep" and "-9 Oct".
# Since all French Revolutionary months have 30 days, only one computation is necessary.
# Exception: the additional days are grouped in a notional 13th month, which lasts
# either 5 or 6 days. In this case, we have 3 formulas for September, at the cost of 2 conversions.
#
sub formulas {
  my ($year, $month) = @_;
  my @formulas = ();
  my @month = qw(Sep Oct Nov Dec Jan Feb Mar Apr May Jun Jul Aug Sep);
  my $date = new Date::Convert::French_Rev $year, $month, 1;
  convert Date::Convert::Gregorian $date;
  my $offset = $date->day() - 1;
  push @formulas, "+$offset $labels{month3}[$date->month() - 1]";
  if ($month < 13)
    {
      $date = new Date::Convert::French_Rev $year, $month, 30;
      convert Date::Convert::Gregorian $date;
      $offset = 30 - $date->day();
      push @formulas, "-$offset $labels{month3}[$date->month() - 1]";
    }
  @formulas;
}

sub html_1 {
  my ($title1) = @_;
  print "<table border><tr><td></td><th align='center' colspan='$columns'>$title1</th></tr><tr align='right'><td></td>\n";
  foreach my $n1 (0 .. $columns - 1)
    {
      printf "<td>%2d", $n1;
      for(my $n0 = $n1 + $columns; $n0 <= 99; $n0 += $columns) 
        { printf "<br>%2d", $n0 % 100 }
      print "<br>&nbsp;" if $n1 > 99 % $columns; # better aligned numbers
      print "</td>\n";
    }
  print "</tr>\n";
  foreach my $year1 (sort { $a <=> $b } keys %end_of_interval)
    {
      print "<tr align='center'><td>$year1 - $end_of_interval{$year1}";
      my $line = $line_for_interval{$year1};
      $line =~ s=(..)=</td><td>$1=g;
      print "$line</td></tr>\n";
    }
  print "</table>\n";
}

sub html_2 {
  my ($part)  = @_;
  my @days    = sort { $a <=> $b } keys %{$letter_of_partday{$part}};
  my $colspan = @days + 1;
  print "<p><table border><tr><th align='center' colspan='$colspan'>$labels{title2}{$part}</th></tr>\n";
  if ($part eq 'b')
    {
      html_2header(1791, $part);
      html_two_formulas($part, $_  ) foreach(1..3);
      html_one_formula ($part, 4, 0);
      html_2header(1792, $part);
      html_one_formula ($part, 4, 1);
      html_two_formulas($part, 5);
      html_one_formula ($part, 6, 0);
    }
  else
    {
      html_2header(1792, $part);
      html_one_formula ($part,  6, 1);
      html_two_formulas($part, $_  ) foreach(7..12);
      html_one_formula ($part, 13, 0);
    }

  print "</table>\n";
}

sub html_2header {
  my ($offset, $part) = @_;
  my @letters = sort values %{$letter_of_partday{$part}};
  print "<tr align='center'><th>"
      , join('</th><th>', "$labels{year_ttl} + $offset", @letters)
      , "</th></tr>\n"; 
}

sub html_two_formulas {
  my ($part, $month)  = @_;
  my @days    = sort { $a <=> $b } keys %{$letter_of_partday{$part}};
  print "<tr align='center'><td>$fr_month[$month - 1]</td>";
  foreach (@days)
    {
      my $year = $year_of_partday{$part}{$_};
      my @formulas = formulas($year, $month);
      print "<td>$formulas[0]<br>$formulas[1]</td>\n";
    }
  print "</tr>\n";
}

sub html_one_formula {
  my ($part, $month, $nb)  = @_;
  my @days    = sort { $a <=> $b } keys %{$letter_of_partday{$part}};
  print "<tr align='center'><td>$fr_month[$month - 1]</td>";
  foreach (@days)
    {
      my $year = $year_of_partday{$part}{$_};
      my @formulas = formulas($year, $month);
      print "<td>$formulas[$nb]</td>\n";
    }
  print "</tr>\n";
}

sub usage {
  my ($day) = @_;
  my ($y, $m, $d) = unpack "A4A2A2", sprintf "%08d", $day;
  $y += 0; # Remove the leading zeros
  # We want neither Ventôse nor additional days for the first example,
  # so we choose a random month.
  if ($m == 6 || $m == 13)
    {
      my @m = qw(1 2 3 4 5 7 8 9 10 11 12);
      $m = $m[11 * rand];
    }

  # First example
  my $date = new Date::Convert::French_Rev $y, $m, $d;
  my $title_date = $date->date_string("%d %B %EY");
  convert Date::Convert::Gregorian $date;
  my $y2       = sprintf "%02d", $y % 100;
  my $part     = $m <= 6 ? 'b' : 'e';
  my $offset   = $part eq 'e' ? 1792 : 1791;
  my $letter   = letter_of_yearpart($y, $part);
  my $word     = word_for_year($y);
  my @formulas = formulas($y, $m);
  my $limit    = $1 if $formulas[1] =~ /(\d+)/;
  my $formula  = $formulas[$d <= $limit ? 0 : 1];
  my $gyear    = $date->year();
  my $gmonth   = $date->month();
  my $gday     = $date->day();
  my $begint; # Beginning of the interval
  foreach (sort { $a <=> $b } keys %end_of_interval)
    {
      last if $y < $_;
      $begint = $_;
    }
  my $gr_date  = &{$labels{format}}($gyear, $gmonth, $gday, $lang);
  $_ = eval "qq($labels{usage3})";
  print;
  print "\n";

  # Second example: Ventôse
  # $m = 6;
  $date = new Date::Convert::French_Rev $y, 6, $d;
  $title_date = $date->date_string("%d %B %EY");
  convert Date::Convert::Gregorian $date;
  @formulas   = formulas($y, 6);
  my $bletter = letter_of_yearpart($y, 'b');
  my $eletter = letter_of_yearpart($y, 'e');
  $gyear      = $date->year();
  $gmonth     = $date->month();
  $gday       = $date->day();
  $gr_date  = &{$labels{format}}($gyear, $gmonth, $gday, $lang);
  $limit = $1 if $formulas[1] =~ /(\d+)/;
  if ($d <= $limit)
    { $formula = $formulas[0]; $offset = 1791 }
  else
    { $formula = $formulas[1]; $offset = 1792 }
  $_ = eval "qq($labels{usage4})";
  print;
}

__END__

=head1 NAME

r2g_table -  Print a few  charts which can  be used to convert  a date from the French Revolutionary calendar to the Gregorian calendar.

=head1 SYNOPSIS

r2g_table [--columns=I<nb>] [--example=I<date>] [--lang=I<language>] [--table-workaround]

=head1 DESCRIPTION

This program prints three tables, plus a small text showing how to use
these tables.  The output  uses the HTML  format. When printed  from a
table-aware web  browser, these tables  allow a computer-less  user to
convert dates from the  French Revolutionary calendar to the Gregorian
calendar.

=head1 OPTIONS

=over 4

=item columns

The number of columns in the  the first table. This must be a multiple
of 4, plus  1. With 5, you  get a narrow table with  many lines, while
with 13 or even 17, you get a wide table with fewer lines.

=item example

The  instructions for  use need  a date  as an  example. The  user can
select the  date that  will be used  as an example  (French Revolution
date,  YYYYMMDD numeric  format). Actually,  the instructions  use two
examples: the first one not in Ventôse, the second one in Ventôse.  If
the user provides a date in  Ventôse, the program will select a random
month for the first example.

=item lang

Select  the language  that  will be  used  for all  language-dependant
elements, including the instructions for use. Available languages are:

=over 4

=item en

English (default)

=item us

English, with the Gregorian dates formatted in the US way (December 1,
2001)

=item fr

French

=back

=item table-workaround

I have noticed that when one of the web browsers I use renders tables,
it has  problems with  plain text following  the tables, and  it might
skip a few  plain text lines. In the present case,  the first lines of
the  instructions for  use  disappear.  The  workaround  I have  found
consists in  building a  table around the  instructions for  use. This
option triggers this workaround.

=back

=head1 AUTHOR

Jean Forget <JFORGET@cpan.org>