#!/usr/bin/perl
#
# Copyright 2009 Abhijit Menon-Sen <ams@toroid.org>
# Use, modification, and distribution of this code is allowed without
# any limitations. There is no warranty, express or implied.

use POSIX;

sub is_leap {
    my ($y) = @_;
    return ($y % 4) == 0 && (($y % 100) != 0 || ($y % 400) == 0);
}

my $year = $ARGV[0] || 1900+(localtime)[5];
my $first = (localtime(mktime(1,0,0,1,0,$year-1900)))[6];

my ($nowd,$nowm,$nowy) = (localtime)[3,4,5];
$nowy += 1900;

my @months =
    ( ["January", 31],
      ["February", is_leap($year) ? 29 : 28 ],
      ["March", 31], ["April", 30], ["May", 31], ["June", 30], ["July", 31],
      ["August", 31], ["September", 30], ["October", 31], ["November", 30],
      ["December", 31] );

my @days =
    qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sunday);

# We'll step through every day in the year, figuring out what day of the
# week it is (and keeping track of which month we're in), and record the
# results in @w.

my $d = 1;
my $sum = 0;
my $month = 0;
my $ydays = 337+$months[1]->[1];

my @w;
while ( $d <= $ydays ) {
    my $w = ($d-1+$first)%7;

    push @w, [ $d-$sum, $w ];

    $d++;

    # (Are we past the end of the current month?)
    my $mdays = $months[$month]->[1];
    if ( $d-$sum > $mdays ) {
        $sum += $mdays;
        $month++;
    }
}

# And now for the messy details of formatting the output.
#
# We'll extract each month's dates from @w, find the first weekend in
# the month, and use that to align the output: if the first day of the
# month is a Sunday, then the first full weekend would be in column 6;
# and that's the furthest right it can go, so we always put it there.

my $i = 0;
while ( @w ) {
    my @row;

    my $firstw;
    my @r = splice( @w, 0, $months[$i]->[1] );

    my $j = 0;
    foreach ( @r ) {
        my ($v, $w) = @$_;

        # Record the position of the first full weekend in the month.
        if ( !defined $firstw && $w == 6 && $r[$j+1]->[1] == 0 ) {
            $firstw = $j;
        }

        $v = sprintf "%2d", $v;

        # Today's date is green.
        if ( $year == $nowy && $i == $nowm && $_->[0] == $nowd ) {
            $v =~ s/^(.*)$/\x1B[32m$1\x1B[39m/;
        }

        # Weekend dates are red.
        if ( $w == 0 || $w == 6 ) {
            $v =~ s/^(.*)$/\x1B[31m$1\x1B[39m/;
        }

        push @row, $v;
        $j++;
    }

    unshift( @row, "  " ) for 1..6-$firstw;
    print join( " ", @row );
    print "\n";

    $i++;
}