#! /usr/local/bin/perl -w
# For Emacs: -*- coding: utf-8 -*-

# Generate a French civil calendar for a given month or year.  Use
# with argument YYYY-MM or YYYY to specify month or year in question
# (default: current month).  Additional options are -i to read an
# input file to add events on the calendar cells, and -o to specify
# output filename.

# Input format is simple but rigid: events are given by multiple lines
# of the form "Field: value", and events are separated by blank lines.
# Only three fields are defined: "Type" can be "EVENT" or "TODO"
# (defaults to "EVENT") and determines color on the calendar,
# "Summary" (required) is the line that is printed on the calendar,
# "Date" (required) is the event's (starting) date and optional time
# in ISO format, and "End-Date" (optional) is the event's end date and
# optional time.  Event will be displayed from date to end-date
# inclusive (but if end-date is on midnight, it is brought back by a
# minute to avoid spanning an extra day).  The date format is
# YYYY-MM-DD or YYYYMMDD; this can be followed by an optional 24h time
# in the format HH:mm:ss (separate date and time with a capital "T"),
# and by an optional time zone which is either "Z" for UTC, or an
# offset to UTC like "-0500"; in the absence of time zone information,
# local time is assumed (and events are printed on the calendar _in_
# local time).

# This program is in the Public Domain: do what you will with it, but
# I won't take any responsability.
# -- David A. Madore <URL: http://www.madore.org/~david/ >  2007-12-17

# This version: 2020-01-28

use strict;
use warnings;
use utf8;

use Encode;

use Getopt::Std;

use Time::Local qw(timelocal);

use Math::Trig;

use Astro::MoonPhase;

use Gtk2;
use Gtk2::Pango;

use constant nb_wday    => 7;  # Days in a week
use constant nb_month   => 12;
use constant weekend    => 5;

use constant centimeter => 72/2.54;


# Get options.

my %opts;
getopts('o:i:', \%opts);

my $ofile = "calendar.pdf";
$ofile = $opts{o} if exists($opts{o});

my $ifile = $opts{i};

my $year;
my $month;
die "Expected 0 or 1 argument" if ( scalar(@ARGV) >= 2 );
if ( defined($ARGV[0]) ) {
    die "Bad month format: expecting YYYY-MM or YYYY"
	unless $ARGV[0] =~ /^(\d{4})(?:\-(\d{2}))?$/;
    $year = $1;
    $month = $2 - 1 if defined($2);
#    die "Year out of range" unless $year >= 1901 && $year <= 2037;  # End of the Unix world. :-(
    if ( defined($month) ) {
	die "Month out of range" unless $month >= 0 && $month < nb_month;
    }
} else {
    my @now = localtime(time);
    $year = $now[5] + 1900;
    $month = $now[4];
}


# Labels for stuff

my @wday_list = ("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi",
		"Samedi", "Dimanche");

my @month_list = ("Janvier", "Février", "Mars", "Avril",
		  "Mai", "Juin", "Juillet", "Août",
		  "Septembre", "Octobre", "Novembre", "Décembre");

my @phase_strings = ("\x{25CF}", "\x{263D}", "\x{274D}", "\x{263E}");
my @season_strings = ("\x{2652}", "\x{2653}", "\x{2648}",
		      "\x{2649}", "\x{264A}", "\x{264B}",
		      "\x{264C}", "\x{264D}", "\x{264E}",
		      "\x{264F}", "\x{2650}", "\x{2651}");


# Variables controlling position of everything on paper

my $paper_width = 29.7*centimeter;
my $paper_height = 21.0*centimeter;
my $margin = 0.8*centimeter;

my $whole_left = $margin;
my $whole_right = $paper_width - $margin;
my $whole_width = $whole_right - $whole_left;
my $whole_top = $margin;
my $whole_bot = $paper_height - $margin;
my $whole_height = $whole_bot - $whole_top;

my $title_font_size = 24;
my $title_height = 3*$title_font_size;  # Height of title _box_
my $title_top = $margin;  # Top of title _box_
my $title_bot = $title_top + $title_height;
my $title_pos = $title_top + $title_height/2 - 0.75*$title_font_size;
    # Vertical pos. of title text

my $title_font = Gtk2::Pango::FontDescription->new;
$title_font->set_family("DejaVu Sans");
$title_font->set_size($title_font_size*PANGO_SCALE);
$title_font->set_weight("bold");

my $smallcal_font_size = 6;
my $smallcal_line_sep = 1.5*$smallcal_font_size;
my $smallcal_col_sep = 2.5*$smallcal_font_size;
my $smallcal_pos0 = ($title_top+$title_bot)/2 - 0.75*$smallcal_font_size
    - 3*$smallcal_line_sep;  # First line of small calendar
my $smallcal_left = $whole_left + 0.25*centimeter;  # Left of left small cal.
my $smallcal_right = $whole_right - 0.25*centimeter;  # Right of right small cal.

my $smallcal_title_font = Gtk2::Pango::FontDescription->new;
$smallcal_title_font->set_family("DejaVu Sans");
$smallcal_title_font->set_size($smallcal_font_size*PANGO_SCALE);
$smallcal_title_font->set_weight("bold");
my $smallcal_font = Gtk2::Pango::FontDescription->new;
$smallcal_font->set_family("DejaVu Sans");
$smallcal_font->set_size($smallcal_font_size*PANGO_SCALE);

my $wday_font_size = 14;
my $wday_height = 2*$wday_font_size;  # Height of blank region for week days
my $wday_top = $title_bot + 0.25*centimeter;  # Top of blank region for week days
my $wday_bot = $wday_top + $wday_height;
my $wday_pos = $wday_top + $wday_height - 1.75*$wday_font_size;
    # Vertical pos. of week day text

my $wday_font = Gtk2::Pango::FontDescription->new;
$wday_font->set_family("DejaVu Sans");
$wday_font->set_size($wday_font_size*PANGO_SCALE);

# The main region
my $main_top = $wday_bot;
my $main_bot = $whole_bot;
my $main_height = $main_bot - $main_top;
my $main_left = $whole_left;
my $main_right = $whole_right;
my $main_width = $main_right - $main_left;

my $ordinal_font_size = 12;
my $ordinal_rpos = 0.25*$ordinal_font_size;  # Vert. pos. relative to top of day box
my $ordinal_rright = -0.4*$ordinal_font_size;  # Hor. pos relative to right of box
my $ordinal_font = Gtk2::Pango::FontDescription->new;
$ordinal_font->set_family("DejaVu Serif");
$ordinal_font->set_size($ordinal_font_size*PANGO_SCALE);
$ordinal_font->set_weight("bold");

my $holiday_font_size = 8;
my $holiday_rpos = $ordinal_rpos + 1.25*$ordinal_font_size + 0.25*$holiday_font_size;
my $holiday_rright = -0.4*$holiday_font_size;
my $holiday_font = Gtk2::Pango::FontDescription->new;
$holiday_font->set_family("DejaVu Serif");
$holiday_font->set_size($holiday_font_size*PANGO_SCALE);
$holiday_font->set_style("italic");

my $iso_font_size = 4;
my $iso_rpos = 0.25*$iso_font_size;
my $iso_rleft = 0.4*$iso_font_size;
my $iso_font = Gtk2::Pango::FontDescription->new;
$iso_font->set_family("DejaVu Sans Mono");
$iso_font->set_size($iso_font_size*PANGO_SCALE);

my $astro_font_size = 12;
my $astroh_font_size = 3;
my $astro_rpos = 0.25*$astro_font_size - $astroh_font_size;
my $astroh_rpos = 1.5*$astro_font_size - 0.75*$astroh_font_size;
my $astro_font = Gtk2::Pango::FontDescription->new;
$astro_font->set_family("DejaVu Sans");
$astro_font->set_size($astro_font_size*PANGO_SCALE);
my $astroh_font = Gtk2::Pango::FontDescription->new;
$astroh_font->set_family("DejaVu Sans");
$astroh_font->set_size($astroh_font_size*PANGO_SCALE);

my $event_font_size = 6;
my $event_line_sep = 1.5*$event_font_size;  # Vert. separation between two events
my $event_line_height = 2*$event_font_size;  # Height of an event box
my $event_rtop = $holiday_rpos + 1.5*$holiday_font_size;
    # V. pos. of topmost event box (relative to day box)
my $event_rrpos = 0.25*$event_font_size;  # V. pos. of text within event box
my $event_hout = 0.4*$event_font_size;  # Horizontal margin outside event box
my $event_hin = 0.4*$event_font_size;  # Horizontal margin inside event box
my $event_font = Gtk2::Pango::FontDescription->new;
$event_font->set_family("DejaVu Sans");
$event_font->set_size($event_font_size*PANGO_SCALE);

# The drawing surface and context
my $surface = Cairo::PdfSurface->create ($ofile, $paper_width, $paper_height);
die "Can't create PdfSurface $ofile: $!" unless defined($surface);
my $cr = Cairo::Context->create ($surface);
$cr->set_line_cap ("round");
$cr->set_line_join ("round");
$cr->set_source_rgb (0., 0., 0.);

sub make_layout {
    # Return a Cairo Pango layout for the given string in the given font.
    my $font_desc = shift;
    my $text = shift;
    my $layout = Gtk2::Pango::Cairo::create_layout($cr);
    $layout->set_font_description($font_desc);
    $layout->set_text($text);
    return $layout;
}

sub layout_width {
    my $layout = shift;
    return ($layout->get_size)[0]/PANGO_SCALE;
}

sub show_layout_centered {
    # Center a layout at a given position.
    my $cr = shift;
    my $layout = shift;
    my $cx = shift;
    my $cy = shift;
    $cr->move_to($cx-layout_width($layout)/2, $cy);
    Gtk2::Pango::Cairo::show_layout ($cr, $layout);
}

sub show_layout_right {
    # Right flush a layout at a given position.
    my $cr = shift;
    my $layout = shift;
    my $rx = shift;
    my $ry = shift;
    $cr->move_to($rx-layout_width($layout), $ry);
    Gtk2::Pango::Cairo::show_layout ($cr, $layout);
}

sub show_layout_left {
    # Left flush a layout at a given position.
    my $cr = shift;
    my $layout = shift;
    my $lx = shift;
    my $ly = shift;
    $cr->move_to($lx, $ly);
    Gtk2::Pango::Cairo::show_layout ($cr, $layout);
}


# Computations of seasons; as Emacs does, we use the formulae from
# Meeus ("Astronomical Algorithms", 1991), except for the mean values
# of quadratures which were obtained by fitting tables of data for
# years 1000 to 3000.

my @solar_mean_data = (
    [2.45156426036966e+06, 3.6524275074416e+05, -1.812456e-02,
     -8.99766e-03, -4.0622e-04],
    [2.45159385039039e+06, 3.6524261811218e+05, 2.332550e-02,
     -7.66513e-03, -6.8401e-04],
    [2.45162380972295e+06, 3.6524236965578e+05, 5.219262e-02,
     -4.31533e-03, -1.00638e-03],
    [2.45165427086271e+06, 3.6524206725655e+05, 5.993577e-02,
     5.0730e-04, -1.25674e-03],
    [2.45168523597288e+06, 3.6524179167500e+05, 4.267877e-02,
     5.53236e-03, -1.29435e-03],
    [2.45171656762077e+06, 3.6524162135752e+05, 4.04760e-03,
     9.07438e-03, -1.06991e-03],
    [2.45174802128022e+06, 3.6524160681607e+05, -4.468817e-02,
     9.80916e-03, -7.0048e-04],
    [2.45177931565284e+06, 3.6524175200760e+05, -8.860513e-02,
     7.54154e-03, -3.1059e-04],
    [2.45181021711621e+06, 3.6524201320999e+05, -1.150140e-01,
     3.26618e-03, -8.200e-05],
    [2.45184060617206e+06, 3.6524231577155e+05, -1.178572e-01,
     -1.54765e-03, -9.11e-06],
    [2.45187050426338e+06, 3.6524257875316e+05, -9.816302e-02,
     -5.63362e-03, -4.985e-05],
    [2.45190005941827e+06, 3.6524273630741e+05, -6.198886e-02,
     -8.24854e-03, -1.9368e-04],
);

sub solar_mean_quadrature {
    # Return the (fractional!) Julian date, in dynamical/ephemeris
    # time, of mean quadrature ($k=0 for Aquarius up to $k=11 for
    # Capricornus) for a given year.
    my $year = shift;
    my $k = shift;
    my $z = ($year-2000)/1000.;
    my $l = $solar_mean_data[$k];
    my $v = 0.;
    my $zpow;
    for ( my $n=0 ; $n<scalar(@{$l}) ; $n++ ) {
	if ( $n == 0 ) {
	    $zpow = 1;
	} else {
	    $zpow *= $z;
	}
	$v += $$l[$n] * $zpow;
    }
    return $v;
}

my @solar_perturb_data = (
    [485, 324.96, 1934.136],
    [203, 337.23, 32964.467],
    [199, 342.08, 20.186],
    [182, 27.85, 445267.112],
    [156, 73.14, 45036.886],
    [136, 171.52, 22518.443],
    [77, 222.54, 65928.934],
    [74, 296.72, 3034.906],
    [70, 243.58, 9037.513],
    [58, 119.81, 33718.147],
    [52, 297.17, 150.678],
    [50, 21.02, 2281.226],
    [45, 247.54, 29929.562],
    [44, 325.15, 31555.956],
    [29, 60.93, 4443.417],
    [18, 155.12, 67555.328],
    [17, 288.79, 4562.452],
    [16, 198.04, 62894.029],
    [14, 199.76, 31436.921],
    [12, 95.39, 14577.848],
    [12, 287.11, 31931.756],
    [12, 320.81, 34777.259],
    [9, 227.73, 1222.114],
    [8, 15.45, 16859.074]
);

sub solar_quadrature {
    # Return the (fractional!) Julian date, in universal time, of true
    # quadrature ($k=0 for Aquarius up to $k=11 for Capricornus) for a
    # given year.
    my $year = shift;
    my $k = shift;
    my $jde0 = solar_mean_quadrature $year, $k;
    my $t = ($jde0-2451545.)/36525.;  # In Julian centuries since J2000
    my $w = ($t*35999.373)-2.47;  # In degrees
    my $l = 1. + 0.0334*cos(deg2rad($w)) + 0.0007*cos(2*deg2rad($w));
    my $s = 0.;
    foreach my $term ( @solar_perturb_data ) {
	my $a = $$term[0];
	my $b = $$term[1];
	my $c = $$term[2];
	my $angle = $b + $c*$t;
	$s += $a * cos(deg2rad($angle));
    }
    my $jd = $jde0 + 0.00001 * $s/$l;  # Dynamical time
    my $corr = 102.2 + 123.5*$t + 32.5*$t*$t;
    return $jd - $corr/86400.;
}


# Calendar functions

sub is_leap {
    # Is a year leap?
    use integer;
    my $year = shift;
    return ($year%4==0)&&((!($year%100==0))||($year%400==0));
}

sub julian_date_1march {
    # Return Julian date of March 1 of given year.
    use integer;
    my $year = shift;
    return 1721120 + $year*365 + $year/4 - $year/100 + $year/400;
}

my @month_first = ( -59, -28, 0, 31, 61, 92, 122, 153, 184, 214, 245, 275 );

sub julian_date {
    # Return Julian date of a given date; warning: month ranges 0-11!
    my $year = shift;
    my $month = shift;
    my $day = shift;
    return julian_date_1march($year) + $month_first[$month]
	- ($month<2 && is_leap($year)) + ($day-1);
}

sub prevmonth {
    # Returns previous month of a given month; month ranges 0-11!
    my $year = shift;
    my $month = shift;
    my $prevmonth_year = $year;
    my $prevmonth_month = $month-1;
    if ( $prevmonth_month < 0 ) {
	$prevmonth_year--;
	$prevmonth_month += nb_month;
    }
    return ($prevmonth_year, $prevmonth_month);
}

sub nextmonth {
    # Returns next month of a given month; month ranges 0-11!
    my $year = shift;
    my $month = shift;
    my $nextmonth_year = $year;
    my $nextmonth_month = $month+1;
    if ( $nextmonth_month >= nb_month ) {
	$nextmonth_year++;
	$nextmonth_month -= nb_month;
    }
    return ($nextmonth_year, $nextmonth_month);
}

sub calendar {
    # Compute a calendar for a given year and month.  Returns a list
    # of weeks, each being a (reference to a) list of days, each being
    # a (reference to a) hash of day properties.  Calendar fully
    # contains every week intersecting the given month.
    my $year = shift;
    my $month = shift;
    my $month_start = julian_date ($year, $month, 1);
    my $first_day = $month_start - $month_start%nb_wday;
    my ($nextmonth_year, $nextmonth_month) = nextmonth ($year, $month);
    my $nextmonth_start = julian_date ($nextmonth_year, $nextmonth_month, 1);
    my $month_last = $nextmonth_start - 1;
    my ($prevmonth_year, $prevmonth_month) = prevmonth ($year, $month);
    my $prevmonth_start = julian_date ($prevmonth_year, $prevmonth_month, 1);
    my $terminal_day = $month_last - $month_last%nb_wday + 7;
    my $nb_weeks = ($terminal_day-$first_day)/nb_wday;
    my @cal = ();
    for ( my $wk=0 ; $wk<$nb_weeks ; $wk++ ) {
	my @week = ();
	my $week_start = $first_day + $wk*nb_wday;
	my $week_thursday = $week_start + 3;
	my $wyear;
	if ( $week_thursday < $month_start ) {
	    $wyear = $prevmonth_year;
	} elsif ( $week_thursday > $month_last ) {
	    $wyear = $nextmonth_year;
	} else {
	    $wyear = $year;
	}
	my $wnum;
	{
	    use integer;
	    $wnum = ($week_thursday - julian_date($wyear,0,1)) / nb_wday
		+ 1;
	}
	for ( my $wday=0 ; $wday<nb_wday ; $wday++ ) {
	    my $julian_date = $week_start + $wday;
	    my ($relmonth, $absyear, $absmonth, $ordinal);
	    if ( $julian_date < $month_start ) {
		$relmonth = -1;
		$absyear = $prevmonth_year;
		$absmonth = $prevmonth_month;
		$ordinal = $julian_date - $prevmonth_start + 1;
	    } elsif ( $julian_date > $month_last ) {
		$relmonth = +1;
		$absyear = $nextmonth_year;
		$absmonth = $nextmonth_month;
		$ordinal = $julian_date - $nextmonth_start + 1;
	    } else {
		$relmonth = 0;
		$absyear = $year;
		$absmonth = $month;
		$ordinal = $julian_date - $month_start + 1;
	    }
	    my %day = ( julian_date => $julian_date,
			wk=> $wk, wday => $wday,
			relmonth => $relmonth,
			absyear => $absyear,
			absmonth => $absmonth,
			ordinal => $ordinal,
			yord => $julian_date-julian_date($absyear,0,1)+1,
			yrord => julian_date($absyear+1,0,1)-$julian_date-1,
			wyear => $wyear, wnum => $wnum );
	    push @week, \%day;
	}
	push @cal, \@week;
    }
    return @cal;
}

sub easter {
    # Returns the Julian date of (the Gregorian) Easter for the given year.
    use integer;
    my $year = shift;
    my $a = $year%19;
    my $b = $year/100;
    my $c = $year%100;
    my $d = $b/4;
    my $e = $b%4;
    my $f = ($b+8)/25;
    my $g = ($b-$f+1)/3;
    my $h = (19*$a+$b-$d-$g+15)%30;
    my $i = $c/4;
    my $k = $c%4;
    my $L = (32+2*$e+2*$i-$h-$k)%7;
    my $m = ($a+11*$h+22*$L)/451;
    return julian_date_1march($year) + $h + $L - 7*$m + 21;
}


# Input file handling stuff

sub parse_iso_date {
    # Returns Julian date and, if defined, local hour and minute, for
    # a given iso date or date+time (as a string, e.g.,
    # "2007-12-12T15:00:00Z").
    my $s = shift;
    return undef unless $s =~ /^(\d{4})[\-\ ]?(\d{2})[\-\ ]?(\d{2})(?:[T\ ]?(\d{2})\:?(\d{2})(?:\:?(\d{2}))?(Z|([\+\-])(\d{2})(?:\:?(\d{2}))?)?)?$/;
    my $year = $1;
    my $month = $2 - 1;
    my $day = $3;
    my $hour = $4;
    my $min = $5;
    my $sec = $6;
    my $tz = $7;
    my $tzsign = $8;
    my $tzhour = $9;
    my $tzmin = $10;
    my $julian;
    my $lhour;
    my $lmin;
    if ( ! defined($hour) ) {
	$julian = julian_date ($year, $month, $day);
    } elsif ( ! defined($tz) ) {
	$julian = julian_date ($year, $month, $day);
	$lhour = $hour;
	$lmin = $min;
    } else {
	if ( defined($tzsign) ) {
	    $hour += ($tzsign eq "-"?1:-1)*$tzhour;
	    $min += ($tzsign eq "-"?1:-1)*$tzmin if defined($tzmin);
	}
	$sec = 0 unless defined($sec);
	my $time = (julian_date ($year, $month, $day) - 2440588)*86400 + $hour*3600 + $min*60 + $sec;
	my @lt = localtime($time);
	$julian = julian_date($lt[5]+1900,$lt[4],$lt[3]);
	$lhour = $lt[2];
	$lmin = $lt[1];
    }
    return ($julian, $lhour, $lmin);
}

my %events;  # The hash of events
# The hash of events is indexed by Julian dates, and each value is a
# (reference to a) list of event lines, each event line being a
# (reference to a) hash of event properties.  A given event might be
# linked in several days (but always at the same line).
sub add_event {
    # Add an event to the hash.
    my $evref = shift;
    my ($jstart, $jend, $jtime);
    $jstart = $$evref{date_julian};
    $jend = $$evref{end_date_julian};
    $jend = $jstart unless defined($jend);
    if ( ( defined($$evref{end_date_hour}) && defined($$evref{end_date_min})
	   && $$evref{end_date_hour} == 0 && $$evref{end_date_min} == 0
	   && $jend>$jstart ) ) {
	$jend--;
	# XXX - The iCal format (maybe?) uses an end date one day
	# later in the case where the end date does not specify time:
	# this is perhaps more logical, but also less intuitive.
    }
    $jtime = sprintf ("%02d:%02d", $$evref{date_hour}, $$evref{date_min})
	if defined($$evref{date_hour});
    $$evref{print_start_julian} = $jstart;
    $$evref{print_end_julian} = $jend;
    $$evref{print_time} = $jtime;
    my @jlist;  # List of days in which to link the event
    if ( $jend-$jstart <= nb_wday ) {
	@jlist = ( $jstart..$jend );
	$$evref{unfolded} = 1;
    } else {
	@jlist = ( $jstart, $jend );
    }
    # Now find a free line common to all those days...
    my @line_candidates;
    foreach my $j ( @jlist ) {
	next unless defined($events{$j});
	for ( my $l=0 ; $l<scalar(@{$events{$j}}) ; $l++ ) {
	    $line_candidates[$l] = 1 if defined($events{$j}[$l]);
	}
    }
    my $line = 0;
    $line++ while $line_candidates[$line];
#    printf STDERR "DEBUG: Using line %d for event %s\n", $line, $$evref{summary};
    foreach my $j ( @jlist ) {
	$events{$j} = [] unless defined($events{$j});
	die "This is impossible" if defined($events{$j}[$line]);
	$events{$j}[$line] = $evref;
    }
}

sub preprocess_event {
    # Do basic checking and parsing of event fields.
    my $evref = shift;
    return undef unless defined($$evref{_});
    if ( defined($$evref{type}) ) {
	if ( $$evref{type} eq "EVENT" || $$evref{type} eq "TODO" ) {
	} else {
	    printf STDERR "Warning: unknown event type %s (should be EVENT or TODO)\n", $$evref{type};
	    return undef;
	}
    } else {
	$$evref{type} = "EVENT";
    }
    unless ( defined($$evref{summary}) && defined($$evref{date}) ) {
	print STDERR "Warning: event missing required property\n";
	return undef;
    }
    my ($julian, $lhour, $lmin) = parse_iso_date($$evref{date});
    unless ( defined($julian) ) {
	printf STDERR "Warning: cannot parse date: %s\n", $$evref{date};
	return undef;
    }
    $$evref{date_julian} = $julian;
    $$evref{date_hour} = $lhour;
    $$evref{date_min} = $lmin;
    $$evref{sort_key} = $julian;
    if ( defined($lhour) ) {
	$$evref{sort_subkey} = $lhour*60 + $lmin;
    } else {
	$$evref{sort_subkey} = -1;
    }
    if ( defined($$evref{end_date}) ) {
	($julian, $lhour, $lmin) = parse_iso_date($$evref{end_date});
	unless ( defined($julian) ) {
	    printf STDERR "Warning: cannot parse end date: %s\n", $$evref{end_date};
	    return undef;
	}
	$$evref{end_date_julian} = $julian;
	$$evref{end_date_hour} = $lhour;
	$$evref{end_date_min} = $lmin;
    }
    return 1;
}

if ( defined($ifile) ) {
    # Read in the input file.
    open F, $ifile or die "Can't open $ifile: $!";
    my @evlist;
    my %event = ();
    while (<F>) {
	if ( /^Type:\s+(.*?)$/ ) {
	    $event{_} = 1;
	    $event{type} = $1;
	} elsif ( /^Summary:\s+(.*?)$/ ) {
	    $event{_} = 1;
	    $event{summary} = decode_utf8($1);
	} elsif ( /^Date:\s+(.*?)(\s*)$/ ) {
	    printf STDERR "Warning: date line $. contains trailing whitespace\n"
		unless $2 eq "\n" || $2 eq "\r\n";
	    $event{_} = 1;
	    $event{date} = $1;
	} elsif ( /^End-Date:\s+(.*?)(\s*)$/ ) {
	    printf STDERR "Warning: date line $. contains trailing whitespace\n"
		unless $2 eq "\n" || $2 eq "\r\n";
	    $event{_} = 1;
	    $event{end_date} = $1;
	} elsif ( /^X-[A-Za-z0-9\-]+:\s+(.*?)$/ ) {
	    $event{_} = 1;
	} elsif ( /^(\s*)$/ ) {
	    printf STDERR "Warning: blank line $. contains whitespace\n"
		unless $1 eq "\n" || $1 eq "\r\n";
	    if ( preprocess_event(\%event) ) {
		push @evlist, {%event};  # Not \%event: we want a copy!
	    }
	    %event = ();
	} elsif ( /^([A-Za-z0-9\-]+):\s+(.*?)$/ ) {
	    $event{_} = 1;
	    printf STDERR "Warning: unknown event field %s\n", $1;
	} else {
	    print STDERR "Warning: incomprehensible line in input file (aborting parsing)\n";
	    last;
	}
    }
    close F;
    if ( preprocess_event(\%event) ) {
	push @evlist, {%event};  # Not \%event: we want a copy!
    }
    @evlist = sort {
	# Sort events in (rough...) chronological order before laying them out.
	my $cmp = $$a{sort_key} <=> $$b{sort_key};
	return $cmp if $cmp;
	$cmp = $$a{sort_subkey} <=> $$b{sort_subkey};
	return $cmp if $cmp;
	return 0;
    } @evlist;
    foreach my $evref ( @evlist ) {
	add_event $evref;
    }
}


# French holidays

my %holidays;  # The hash of holidays
# The hash of holidays is indexed by Julian dates, and each value is a
# (reference to a) list of (references to a list consisting of) color
# and holiday names for the day in question.  The color is 1 if the
# holiday should be printed in red, or 0 if it is not special.
sub add_holiday {
    my $julian_date = shift;
    my $is_holy = shift;
    my $string = shift;
    if ( defined($holidays{$julian_date}) ) {
	push @{$holidays{$julian_date}}, [$is_holy, $string];
    } else {
	my @list = ( [$is_holy, $string] );
	$holidays{$julian_date} = \@list;
    }
}

my $easter = easter($year);
add_holiday (julian_date ($year-1, 12-1, 25), 1, "Noël");
add_holiday (julian_date ($year, 1-1, 1), 1, "Jour de l’an");
add_holiday (julian_date ($year, 1-1, 6), 0, "Épiphanie");
add_holiday (julian_date ($year, 2-1, 14), 0, "Saint-Valentin");
add_holiday ($easter-47, 0, "Mardi gras");
{
    my $apr1 = julian_date ($year, 4-1, 1);
    add_holiday ($apr1-($apr1%nb_wday)-1, 0, "\x{2023}h. d’été");
}
add_holiday ($easter, 1, "Pâques");
add_holiday ($easter+1, 1, "L. de Pâques");
add_holiday (julian_date ($year, 5-1, 1), 1, "F. travail");
add_holiday ($easter+39, 1, "Ascension");
add_holiday (julian_date ($year, 5-1, 8), 1, "Victoire 1945");
add_holiday ($easter+49, 1, "Pentecôte");
add_holiday ($easter+50, 1, "L. de Pentecôte");
{
    my $june1 = julian_date ($year, 6-1, 1);
    my $mothers_day = ($june1-($june1%nb_wday)-1);
    $mothers_day += 7 if $mothers_day == $easter+49;
    my $fathers_day = ($june1-($june1%nb_wday)-1)+21;
    add_holiday ($mothers_day, 0, "Fête des mères");
    add_holiday ($fathers_day, 0, "Fête des pères");
}
add_holiday (julian_date ($year, 7-1, 14), 1, "Fête nat.le");
add_holiday (julian_date ($year, 8-1, 15), 1, "Assomption");
{
    my $nov1 = julian_date ($year, 11-1, 1);
    add_holiday ($nov1-($nov1%nb_wday)-1, 0, "\x{2023}h. d’hiver");
}
add_holiday (julian_date ($year, 11-1, 1), 1, "Toussaint");
add_holiday (julian_date ($year, 11-1, 11), 1, "Armistice 1918");
add_holiday (julian_date ($year, 12-1, 25), 1, "Noël");
add_holiday (julian_date ($year+1, 1-1, 1), 1, "Jour de l’an");


# Seasons: %seasons is a hash indexed by Julian dates, and each value
# is a value from 0 through 3 (if defined) indicating the season
# starting at that day (if there is one).
my %seasons;
{
    for ( my $k=0 ; $k<12 ; $k++ ) {
	my $jd = solar_quadrature ($year, $k);
	my @lt = localtime(($jd-2440587.5)*86400.);
	my $julian_date = julian_date($lt[5]+1900,$lt[4],$lt[3]);
	$seasons{$julian_date} = [$k,$lt[2],$lt[1]];
# 	printf STDERR "DEBUG: season %d at julian date %f\n", $k, $jd;
# 	printf STDERR "DEBUG: = local %04d-%02d-%02d (JD %d) %02d:%02d:%02d\n", $lt[5]+1900, $lt[4]+1, $lt[3], $julian_date, $lt[2], $lt[1], $lt[0];
    }
}


# "Main" stuff

sub smallcal {
    # Lay out a small calendar for given year and month at given
    # (left) horizontal and (top) vertical coordinates.
    my $year = shift;
    my $month = shift;
    my $left = shift;
    my $pos0 = shift;
    $cr->save;
    my @smallcal = calendar ($year, $month);
    my $smallcal_title_layout
	= make_layout ($smallcal_title_font,
		       sprintf("%s %d", $month_list[$month], $year));
    show_layout_centered ($cr, $smallcal_title_layout,
			  $left+$smallcal_col_sep*(nb_wday/2), $pos0);
    foreach my $week ( @smallcal ) {
	foreach my $day ( @{$week} ) {
	    next unless $$day{relmonth} == 0;
	    my $mark_red = $$day{wday} >= weekend;
	    my $lref = $holidays{$$day{julian_date}};
	    if ( defined($lref) && ! $mark_red ) {
		foreach my $v ( @{$lref} ) {
		    $mark_red = 1 if $$v[0];
		}
	    }
	    if ( $mark_red ) {
		$cr->set_source_rgb (0.4, 0., 0.);
	    } else {
		$cr->set_source_rgb (0., 0., 0.);
	    }
	    my $smallcal_ordinal_layout
		= make_layout ($smallcal_font, $$day{ordinal});
	    show_layout_right ($cr, $smallcal_ordinal_layout,
			       $left+$smallcal_col_sep*(1+$$day{wday}),
			       $pos0+$smallcal_line_sep*(1+$$day{wk}));
	}
    }
    $cr->restore;
}

sub do_month {
# Do a calendar month.  This is absolutely gross (not even indented,
# because it used to be part of the main program).

my $year = shift;
my $month = shift;

# Draw title.
$cr->save;
$cr->rectangle ($whole_left, $title_top, $whole_width, $title_height);
$cr->save;
$cr->set_source_rgb (0.8, 0.8, 1.);
$cr->fill_preserve;
$cr->restore;
$cr->set_line_width (2.);
$cr->stroke;
my $title_layout
    = make_layout ($title_font, sprintf("%s %d", $month_list[$month], $year));
show_layout_centered ($cr, $title_layout, $paper_width/2, $title_pos);
$cr->restore;

# Draw week day names.
for ( my $i=0 ; $i<nb_wday ; $i++ ) {
    $cr->save;
    my $wday_layout = make_layout ($wday_font, $wday_list[$i]);
    if ( $i >= weekend ) {
	$cr->set_source_rgb (0.4, 0., 0.);
    } else {
	$cr->set_source_rgb (0., 0., 0.);
    }
    show_layout_centered ($cr, $wday_layout,
			  $margin+($i+0.5)*$whole_width/nb_wday,
			  $wday_pos);
    $cr->restore;
}

my ($prevmonth_year, $prevmonth_month) = prevmonth ($year, $month);
my ($nextmonth_year, $nextmonth_month) = nextmonth ($year, $month);

# Phases of the Moon: %moonphases is a hash indexed by Julian dates,
# and each value is a value from 0 through 3 (if defined) indicating
# the Moon phase at that day (if there is one).
my %moonphases;
{
    my $time0 = timelocal(0,0,0,1,$month,$year-1900) - 610000;
    my $time1 = timelocal(0,0,0,1,$nextmonth_month,$nextmonth_year-1900) + 610000;
    my ($phase,@times) = phaselist($time0,$time1);
    foreach my $time ( @times ) {
	my @lt = localtime($time);
	my $julian_date = julian_date($lt[5]+1900,$lt[4],$lt[3]);
	$moonphases{$julian_date} = [$phase,$lt[2],$lt[1]];
	$phase = ($phase+1)%4;
    }
}

# Draw small calendars.
smallcal $prevmonth_year, $prevmonth_month, $smallcal_left, $smallcal_pos0;
smallcal $nextmonth_year, $nextmonth_month, $smallcal_right-($smallcal_col_sep*nb_wday), $smallcal_pos0;

# Now for the main calendar...
my @maincal = calendar($year, $month);

my $nb_weeks = scalar(@maincal);

my $cell_width = $main_width/nb_wday;
my $cell_height = $main_height/$nb_weeks;

# First loop: print mostly everything except events.
foreach my $week ( @maincal ) {
    foreach my $day ( @{$week} ) {
	my $wk = $$day{wk};
	my $wday = $$day{wday};
	my $julian_date = $$day{julian_date};
	# Draw the day box.
	$cr->save;
	$cr->rectangle ($main_left + $wday*$cell_width,
			$main_top + $wk*$cell_height,
			$cell_width, $cell_height);
	$cr->set_line_width (1.);
	my $out_of_month = !!$$day{relmonth};
	if ( $out_of_month || $wday >= weekend ) {
	    $cr->save;
	    if ( $out_of_month && $wday >= weekend ) {
		$cr->set_source_rgb (0.75, 0.675, 0.675);
	    } elsif ( $out_of_month ) {
		$cr->set_source_rgb (0.75, 0.75, 0.75);
	    } else {
		$cr->set_source_rgb (1., 0.9, 0.9);
	    }
	    $cr->fill_preserve;
	    $cr->restore;
	}
	$cr->stroke_preserve;
	$cr->save;
	$cr->clip;
	# Print the (ordinal) day number.
	my $ordinal_layout = make_layout ($ordinal_font, $$day{ordinal});
	show_layout_right ($cr, $ordinal_layout,
			   $main_left + $wday*$cell_width + $cell_width + $ordinal_rright,
			   $main_top + $wk*$cell_height + $ordinal_rpos);
	# Print the ISO information and possibly Julian day number.
	my $iso_string = sprintf ("%04d-%02d-%02d\n%04d-W%02d-%d\n%04d-%03d",
				  $$day{absyear}, $$day{absmonth}+1, $$day{ordinal},
				  $$day{wyear}, $$day{wnum}, $$day{wday}+1,
				  $$day{absyear}, $$day{yord});
	unless ( defined($moonphases{$julian_date})
		 || defined($seasons{$julian_date}) ) {
	    $iso_string .= sprintf ("    = JD %07d", $$day{julian_date});
	}
	my $iso_layout = make_layout ($iso_font, $iso_string);
	show_layout_left ($cr, $iso_layout,
			  $main_left + $wday*$cell_width + $iso_rleft,
			  $main_top + $wk*$cell_height + $iso_rpos);
	# Possibly print a holiday line.
	if ( defined($holidays{$julian_date}) ) {
	    $cr->save;
	    $cr->set_source_rgb (0.4, 0., 0.);
	    my @l = @{$holidays{$julian_date}};
	    my $sep_layout = make_layout ($holiday_font, "\x{2022}");
	    my $sep_layout_width = layout_width ($sep_layout);
	    @l = map ({ $_=[$$_[0],make_layout($holiday_font,$$_[1])]; } @l);
	    my $layout_width = 0;
	    my $i;
	    for ( $i=0 ; $i<scalar(@l) ; $i++ ) {
		$layout_width += $sep_layout_width if $i;
		$layout_width += layout_width($l[$i][1]);
	    }
	    my $x = $main_left + $wday*$cell_width + $cell_width
		+ $holiday_rright - $layout_width;
	    my $y = $main_top + $wk*$cell_height + $holiday_rpos;
	    for ( $i=0 ; $i<scalar(@l) ; $i++ ) {
		if ( $i ) {
		    $cr->set_source_rgb (0., 0., 0.);
		    show_layout_left ($cr, $sep_layout, $x, $y);
		    $x += $sep_layout_width;
		}
		if ( $l[$i][0] ) {
		    $cr->set_source_rgb (0.4, 0., 0.);
		} else {
		    $cr->set_source_rgb (0., 0., 0.);
		}
		show_layout_left ($cr, $l[$i][1], $x, $y);
		$x += layout_width($l[$i][1]);
	    }
	    $cr->restore;
	}
	# Possibly print the phase of the Moon or season for the day.
	if ( defined($moonphases{$julian_date}) || defined($seasons{$julian_date}) ) {
	    my ($phase,$phase_hour,$phase_min);
	    ($phase,$phase_hour,$phase_min) = @{$moonphases{$julian_date}} if defined($moonphases{$julian_date});
	    my ($season,$season_hour,$season_min);
	    ($season,$season_hour,$season_min) = @{$seasons{$julian_date}} if defined($seasons{$julian_date});
	    my $astro_string = "";
	    $astro_string .= $phase_strings[$phase] if defined($phase);
	    $astro_string .= $season_strings[$season] if defined($season);
	    my $astro_layout = make_layout ($astro_font, $astro_string);
	    show_layout_centered ($cr, $astro_layout,
				  $main_left + $wday*$cell_width + $cell_width/2,
				  $main_top + $wk*$cell_height + $astro_rpos);
	    my $astroh_string = "";
	    $astroh_string .= sprintf("%02d:%02d",$phase_hour,$phase_min) if defined($phase);
	    $astroh_string .= " | " if defined($phase) && defined($season);
	    $astroh_string .= sprintf("%02d:%02d",$season_hour,$season_min) if defined($season);
	    my $astroh_layout = make_layout ($astroh_font, $astroh_string);
	    show_layout_centered ($cr, $astroh_layout,
				  $main_left + $wday*$cell_width + $cell_width/2,
				  $main_top + $wk*$cell_height + $astroh_rpos);
	}
	$cr->restore;
	$cr->restore;
    }
}

# Second loop: now print events.
foreach my $week ( @maincal ) {
    foreach my $day ( @{$week} ) {
	my $wk = $$day{wk};
	my $wday = $$day{wday};
	my $julian_date = $$day{julian_date};
	my @evlines;
	@evlines = @{$events{$julian_date}} if defined($events{$julian_date});
	for ( my $l=0 ; $l<scalar(@evlines) ; $l++ ) {
	    my $evref = $evlines[$l];
	    next unless defined($evref);
	    # An event gets printed at its first day and at the start
	    # of every week it crosses from then on, so:
	    next if $julian_date > $$evref{print_start_julian} && $wday > 0 && $$evref{unfolded};
	    my $starting = ( $julian_date == $$evref{print_start_julian} );
	    my $ending = 0;
	    my $nbcells;  # Number of cells spanned by the event (_in the week_)
	    my $unfolded = $$evref{unfolded};
	    if ( $unfolded ) {
		$nbcells = $$evref{print_end_julian} - $julian_date + 1;
		if ( $nbcells > nb_wday-$wday ) {
		    $nbcells = nb_wday-$wday;
		} else {
		    $ending = 1;
		}
	    } else {
		$nbcells = 1;
		$ending = ( $julian_date == $$evref{print_end_julian} );
	    }
	    # Compute event box dimensions and position:
	    my $boxwidth = $nbcells*$cell_width - ($starting+$ending)*$event_hout;
	    my $box_x = $main_left + $wday*$cell_width + $starting*$event_hout;
	    my $box_y = $main_top + $wk*$cell_height + $event_rtop + $l*$event_line_sep;
	    $cr->save;
	    $cr->rectangle ($main_left, $main_top + $wk*$cell_height,
			    $main_width, $cell_height);
	    $cr->clip;
	    $cr->rectangle ($box_x, $box_y,
			    $boxwidth, $event_line_height);
	    $cr->save;
	    if ( $$evref{type} eq "TODO" ) {
		$cr->set_source_rgb (1., 1., 0.8);
	    } else {
		$cr->set_source_rgb (0.8, 1., 0.8);
	    }
	    $cr->fill_preserve;
	    $cr->restore;
	    $cr->set_line_width (0.8);
	    $cr->stroke_preserve;
	    $cr->save;
	    $cr->clip;
	    my $event_string = "";
	    if ( $unfolded ) {
		$event_string .= "\x{2026}" unless $starting;
	    } else {
		$event_string .= "\x{2192} " if $starting;
		$event_string .= "\x{2190} " if $ending;
	    }
	    if ( $starting && defined($$evref{print_time}) ) {
		$event_string .= sprintf ("[%s] ", $$evref{print_time});
	    }
	    $event_string .= $$evref{summary};
	    if ( $unfolded ) {
		$event_string .= "\x{2026}" unless $ending;
	    }
	    my $event_layout = make_layout ($event_font, $event_string);
	    show_layout_left ($cr, $event_layout,
			      $box_x + $event_hin, $box_y + $event_rrpos);
	    $cr->restore;
	    $cr->restore;
	}
    }
}

# Done with a month: show the page!
$cr->show_page;

}

# Now run over all required months (triple-yuck!).
if ( defined($month) ) {
    do_month $year, $month;
} else {
    for ( $month=0 ; $month<nb_month ; $month++ ) {
	do_month $year, $month;
    }
}