#!/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 @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 use twenty-eight output columns, except in the exceptional case
# that the first of the year is a Sunday (e.g. 2006), in which case we
# use one more and shift everything one column to the right.

my $skip = 0;
my $columns = 28;

if ( $w[0]->[1] == 0 ) {
    $columns++;
    $skip = 1;
}

# Now we'll step through @w, building up rows of twenty-eight (or nine)
# output fields, which may each contain a two-digit number, or be blank.

my $bg = 0;

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

    # The first output column always represents a Monday (except in the
    # case noted above, when the Monday is shifted right to the second
    # column), so if the first day of the year is not a Monday, we'll
    # leave some columns blank at the beginning.

    if ( $i == 0 && $first > 1 ) {
        push( @row, "  " ) for 1..$first-1;
    }
    elsif ( $i != 0 && $skip ) {
        push( @row, "  " ) for 1..$skip;
    }

    # We fill the rest of the row with the appropriate number of
    # suitably massaged values taken from @w.

    my $n = $columns-@row;
    my @r = splice( @w, 0, $n );

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

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

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

        # If the previous row had a white background (which would have
        # been reset at the end of the line), we'll continue it at the
        # beginning of this row... unless we were going to turn it off
        # anyway in the next step.
        if ( $j == 0 && $bg ) {
            $v =~ s/^/\x1B[4${bg}m/ unless $_->[0] == 1;
        }

        # The beginning of a month toggles the background colour between
        # black (to begin with) and white.
        if ( $_->[0] == 1 && $i != 0 ) {
            $bg = $bg == 0 ? 7 : 0;
            $v =~ s/^/\x1B[4${bg}m/;
        }

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

    $i += @r;

    print join( " ", @row );
    print "\x1B[49m" if $bg;
    print "\n";
}