#!/usr/local/bin/perl -w
# Copyright (c) 2003, 2004, 2010, 2011 Jean Forget. All rights reserved.
use strict;
use Getopt::Long;
use DateTime::Calendar::FrenchRevolutionary;
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 $date = DateTime->from_object(object => DateTime::Calendar::FrenchRevolutionary->new(year => $year, month => $month));
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 $date = DateTime->from_object(object => DateTime::Calendar::FrenchRevolutionary->new(year => $year, month => $month));
my $offset = $date->day() - 1;
push @formulas, "+$offset $labels{month3}[$date->month_0]";
if ($month < 13)
{
#$date = new Date::Convert::French_Rev $year, $month, 30;
#convert Date::Convert::Gregorian $date;
$date = DateTime->from_object(object => DateTime::Calendar::FrenchRevolutionary->new(year => $year, month => $month, day => 30));
$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> " 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;
#convert Date::Convert::Gregorian $date;
my $date_r = DateTime::Calendar::FrenchRevolutionary->new(year => $y, month => $m, day => $d);
my $date_g = DateTime->from_object(object => $date_r);
my $title_date = $date_r->strftime("%d %B %EY");
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_g->year;
my $gmonth = $date_g->month;
my $gday = $date_g->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;
$date_r = DateTime::Calendar::FrenchRevolutionary->new(year => $y, month => 6, day => $d);
$date_g = DateTime->from_object(object => $date_r);
$title_date = $date_r->strftime("%d %B %EY");
@formulas = formulas($y, 6);
my $bletter = letter_of_yearpart($y, 'b');
my $eletter = letter_of_yearpart($y, 'e');
$gyear = $date_g->year;
$gmonth = $date_g->month;
$gday = $date_g->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__
=encoding utf8
=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 UTF-8 encoding and 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>