#!/usr/bin/perl
require 5;
use strict;
use warnings;
# (Run under a sane version of Perl, with optimal error-checking)

# Define some constants:
use constant SECONDS_IN_DAY => 24 * 60 * 60;
use constant DAY_BIG   => 6060; # twips
use constant DAY_SMALL => 2900; # twips

# Open the file and write the prolog
open RTF, ">datebook.rtf" or die $!;
print RTF '{\rtf1\ansi\deff0
{\fonttbl{\f0\fswiss Arial;}{\f1\froman Times New Roman;}}
\deflang1033\plain\fs50
';

# Define our lookup arrays of the names
# of the months and the days of the week
my @months = qw(
 January February March      April   May      June
 July    August   September  October November December
);
my @dows  = qw(
 Sunday Monday Tuesday Wednesday Thursday Friday Saturday
);

# start the datebook today, and end it a year from today
my $then = time();
my $end = $then + 366 * SECONDS_IN_DAY;

while($then <= $end) {
  my($year,$month,$day, $weekday) = (gmtime($then))[5,4,3,6];
  my $space = DAY_BIG;
  $space    = DAY_SMALL if $weekday == 0 or $weekday == 6;
  
  printf RTF
   '{\pard\sa%s\qr\f%s{\b %s,} %s{\super %s} of %s, %s\par}' . "\n",
    $space,
    $month % 2, # toggle the font every month
    $dows[$weekday], $day, th($day), $months[$month], $year + 1900,
  ;
  
  $then += SECONDS_IN_DAY;
}

# end and close the file, and quit the program
print RTF "}";
close(RTF);
exit;


sub th {
  # This is just a function to return the correct ordinal
  #  suffix, like 3 => "rd", so we don't say "February 3th"!
  
  my $n = abs($_[0] || 0);
  return 'th' unless $n and $n == int($n);
  $n %= 100;
  return 'th' if $n == 11 or $n == 12 or $n == 13;
  $n %= 10;
  return 'st' if $n == 1; 
  return 'nd' if $n == 2;
  return 'rd' if $n == 3;
  return 'th';
}

__END__