#!/usr/local/ren/bin/perl -w

# $Id$

use strict;
use warnings;

my @terrestrial = ({
                      'name'   => 'Air',
                      'rgb'    => 'afeeee',
                      'months' => [ { 'name' => 'Ascending',   'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Resplendant', 'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Descending',  'weeks' => '4', 'duration' => 28 }
                      ]
                   },
                   {
                      'name'   => 'Water',
                      'rgb'    => '999999',
                      'months' => [ { 'name' => 'Ascending',   'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Resplendant', 'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Descending',  'weeks' => '4', 'duration' => 28 }
                      ]
                   },
                   {
                      'name'   => 'Earth',
                      'rgb'    => 'f8f8ff',
                      'months' => [ { 'name' => 'Ascending',   'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Resplendant', 'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Descending',  'weeks' => '4', 'duration' => 28 }
                      ]
                   },
                   {
                      'name'   => 'Wood',
                      'rgb'    => '72db72',
                      'months' => [ { 'name' => 'Ascending',   'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Resplendant', 'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Descending',  'weeks' => '4', 'duration' => 28 }
                      ]
                   },
                   {
                      'name'   => 'Fire',
                      'rgb'    => 'ffa590',
                      'months' => [ { 'name' => 'Ascending',   'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Resplendant', 'weeks' => '4', 'duration' => 28 },
                                    { 'name' => 'Descending',  'weeks' => '4', 'duration' => 28 }
                      ]
                   },
                   {
                      'name'   => 'Calibration',
                      'rgb'    => 'dddddd',
                      'months' => [ { 'name' => '', 'weeks' => '', 'duration' => 5 } ]
                   });

my @celestial = ({
                    'name'   => 'Golden<br/>Barque',
                    'rgb'    => 'fafad2',
                    'months' => [ { 'name' => 'The Mast',               'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Air',        'duration' => 1 },
                                  { 'name' => 'The Gull',               'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Journeys',   'duration' => 1 },
                                  { 'name' => 'The Messenger',          'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Fathers',    'duration' => 1 },
                                  { 'name' => 'The Captain',            'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of the Sun',    'duration' => 1 },
                                  { 'name' => 'The Ship&rsquo;s<br/>Wheel', 'weeks'    => '2', 'duration' => 16 }
                    ]
                 },
                 {
                    'name'   => 'Forbidding<br/>Manse',
                    'rgb'    => '7cf391',
                    'months' => [ { 'name' => 'The Treasure<br/>Trove',     'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Water',      'duration' => 1 },
                                  { 'name' => 'The Mask',               'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Secrets',    'duration' => 1 },
                                  { 'name' => 'The Guardians',          'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Admission',  'duration' => 1 },
                                  { 'name' => 'The Sorcerer',           'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Innovation', 'duration' => 1 },
                                  { 'name' => 'The Key',                'weeks'    => '2', 'duration' => 16 }
                    ]
                 },
                 {
                    'name'   => 'Violet<br/>Bier',
                    'rgb'    => 'e3b0fb',
                    'months' => [ { 'name' => 'The Haywain',            'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Earth',      'duration' => 1 },
                                  { 'name' => 'The Corpse',             'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Release',    'duration' => 1 },
                                  { 'name' => 'The Rising<br/>Smoke',       'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Dark Humor', 'duration' => 1 },
                                  { 'name' => 'The Crow',               'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Ancestors',  'duration' => 1 },
                                  { 'name' => 'The Sword',              'weeks'    => '2', 'duration' => 16 }
                    ]
                 },
                 {
                    'name'   => 'Cerulean<br/>Lute',
                    'rgb'    => '97defa',
                    'months' => [ { 'name' => 'The Pillar',          'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Wood',    'duration' => 1 },
                                  { 'name' => 'The Peacock',         'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Color',   'duration' => 1 },
                                  { 'name' => 'The Ewer',            'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Mothers', 'duration' => 1 },
                                  { 'name' => 'The Musician',        'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Love',    'duration' => 1 },
                                  { 'name' => 'The Lovers',          'weeks'    => '2', 'duration' => 16 }
                    ]
                 },
                 {
                    'name'   => 'Crimson<br/>Panoply',
                    'rgb'    => 'fc84ac',
                    'months' => [ { 'name' => 'The Quiver',            'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Fire',      'duration' => 1 },
                                  { 'name' => 'The Shield',            'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of the Moon',  'duration' => 1 },
                                  { 'name' => 'The Banner',            'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Sacrifice', 'duration' => 1 },
                                  { 'name' => 'The Gauntlet',          'weeks'    => '2', 'duration' => 16 },
                                  { 'name' => 'Festival of Battle',    'duration' => 1 },
                                  { 'name' => 'The Spear',             'weeks'    => '2', 'duration' => 16 }
                    ]
                 },
                 {
                    'name'   => 'Calibration',
                    'rgb'    => 'dddddd',
                    'months' => [ {
                                    'name'     => '',
                                    'weeks'    => '',
                                    'duration' => 5
                                  }
                    ]
                 });

my @underworld = ({
                     'name'   => 'Setesh',
                     'rgb'    => 'aaa0a0',
                     'months' => [ { 'name' => 'Ghost<br/>Flame', 'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Jade',        'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Bone',        'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Blood',       'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Prayer',      'weeks' => '3', 'duration' => 21 }
                     ]
                  },
                  {
                     'name'   => 'Eset',
                     'rgb'    => 'f0fff0',
                     'months' => [ { 'name' => 'Ghost<br/>Flame', 'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Jade',        'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Bone',        'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Blood',       'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Prayer',      'weeks' => '3', 'duration' => 21 }
                     ]
                  },
                  {
                     'name'   => 'Nebthys',
                     'rgb'    => '98989f',
                     'months' => [ { 'name' => 'Ghost<br/>Flame', 'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Jade',        'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Bone',        'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Blood',       'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Prayer',      'weeks' => '3', 'duration' => 21 }
                     ]
                  },
                  {
                     'name'   => 'Usine',
                     'rgb'    => 'f8f8ff',
                     'months' => [ { 'name' => 'Ghost<br/>Flame', 'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Jade',        'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Bone',        'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Blood',       'weeks' => '3', 'duration' => 21 },
                                   { 'name' => 'Prayer',      'weeks' => '3', 'duration' => 21 }
                     ]
                  },
                  {
                     'name'   => 'Calibration',
                     'rgb'    => 'dddddd',
                     'months' => [ { 'name' => '', 'weeks' => '', 'duration' => 5 } ]
                  });

my %terr_colors;
build_colors(\%terr_colors, \@terrestrial);
my %cel_colors;
build_colors(\%cel_colors, \@celestial);
my %und_colors;
build_colors(\%und_colors, \@underworld);

my %days;
fill_days(\%days, \%terr_colors, \@terrestrial, 'terrestrial');
fill_days(\%days, \%cel_colors,  \@celestial,   'celestial');
fill_days(\%days, \%und_colors,  \@underworld,  'underworld');

my %track;
$track{'weekdurc'}   = 0;
$track{'monthdurc'}  = 0;
$track{'seasondurc'} = 0;
$track{'weekdurt'}   = 0;
$track{'monthdurt'}  = 0;
$track{'seasondurt'} = 0;
$track{'weekduru'}   = 0;
$track{'monthduru'}  = 0;
$track{'seasonduru'} = 0;
$track{'day'}        = '425';
my @lines;
my $prev;

foreach my $day (reverse sort keys %days)
{
    my $info = $days{$day};
    if (defined $prev)
    {
        addline(\@lines, \%track, $prev, $info);
    }
    $prev = $info;
    $track{'day'} = $day;
}
my $first = $days{'425'};
addline(\@lines, \%track, $prev, $first);

print "<html>\n";
print "<head>\n";
print " <title>Exalted Calendars</title>\n";
print " <link rel=\"StyleSheet\" type=\"text/css\" href=\"http://rpg.divnull.com/exalted/exalted.css\">\n";
print " <meta name=\"keywords\" content=\"Exalted, Wordman, Calendar, First Age, Setesh\">\n";
print " <meta name=\"description\" content=\"A First Age calendar for Exalted.\">\n";
print "</head>\n\n";
print "<body>\n";
print "<h1>Exalted Calendars</h1>\n";
print "<style type=\"text/css\">
	/* <![CDATA[ */
	table.cal { width: auto; }
	th { font-family: sans-serif; font-size: small; background-color: #ddd;}
	td {padding-left: 2px; padding-right: 2px;}
	td.count {padding-left: 10px; padding-right: 10px; color: #aaa;}
	td.day { font-size: xx-small; }
	td.week { font-size: x-small; width: 5px; text-align: center;}
	td.season { font-weight: bold; text-align: center;}
	.break {border-top: 1px solid white;}
	.ter { border-right: 1px solid white;}
	.und { border-right: 1px solid white;}
	.cel { border-left: 1px solid white;}
	/* ]]> */
	</style>";
print "<table class=\"cal\" cellspacing=\"0\" cellpadding=\"0\">\n";
print " <tr>\n";
print "  <th colspan=\"4\">Celestial/First Age</th>\n";
print "  <th class=\"ter cel\">Day</th>\n";
print "  <th colspan=\"4\">Imperial</th>\n";
print "  <th class=\"und cel\">Day</th>\n";
print "  <th colspan=\"4\">Underworld</th>\n";
print " </tr>\n";

foreach my $line (reverse @lines)
{
    print $line;
}
print "</table>\n\n";
print "<p>The Celestial/First Age calendar is <a href=\"\">my own invention</a> based on canonical astrology signs.\n";
print "The Imperial Calendar is canonical. The underworld's Calendar of Setesh is mentioned in canon, but I've invented\n";
print "the <a href=\"\">way the months work</a>.</p>\n\n";
print "<p>The table above was generated by <a href=\"http://thor.divnull.com/pub/exalted/cal.pl.txt\">simple Perl code</a>.</p>\n\n";
print "<hr/>\n\n";
print "<p>Back to <a href=\".\">Wordman&rsquo;s Exalted page</a></p>\n";
print "</body>\n";
print "</html>\n";

sub fill_days
{
    my ($days, $colors, $calendar, $type) = @_;
    my $suffix = substr($type, 0, 1);

    my $day = 1;
    foreach my $info (@$calendar)
    {
        my $season = $info->{'name'};
        my $months = $info->{'months'};
        foreach my $monthinfo (@$months)
        {
            my $month    = $monthinfo->{'name'};
            my $duration = $monthinfo->{'duration'};
            my $weeks    = $monthinfo->{'weeks'} || 1;
            my $inweek   = $duration / $weeks;
            my $date     = 1;
            my $monthkey = "month:$season:$month";
            while ($date <= $duration)
            {
                my $key = sprintf('%03s', $day);
                $days->{$key}{"colorseason$suffix"} = "#$info->{'rgb'};";
                $days->{$key}{"colormonth$suffix"}  = "#$colors->{$monthkey};";
                $days->{$key}{"colorweek$suffix"}   = "#$colors->{$monthkey};";
                $days->{$key}{"colorday$suffix"}    = "#$colors->{$day};";
                $days->{$key}{"$type season"}       = $season;
                $days->{$key}{"$type month"}        = $month;
                my $week = '';

                if ($monthinfo->{'weeks'})
                {
                    my $curweek = int(($date / $inweek) + 0.99);
                    $week = "W e e k &nbsp; $curweek";
                }
                $days->{$key}{"$type week"} = $week;
                $days->{$key}{"$type day"}  = $date;
                $day  += 1;
                $date += 1;
            }
        }
    }

}

sub addline
{
    my ($lines, $track, $prev, $info) = @_;
    my $day = "<td class=\"day count\">$track->{'day'}</td>";

    my ($cseason, $cmonth, $cweek, $cday) = render_cal_line($track, $prev, $info, 'celestial');
    my ($tseason, $tmonth, $tweek, $tday) = render_cal_line($track, $prev, $info, 'terrestrial');
    my ($useason, $umonth, $uweek, $uday) = render_cal_line($track, $prev, $info, 'underworld');

    my $line = " <tr>\n";
    $line .= "  $cseason\n" if $cseason;
    $line .= "  $cmonth\n"  if $cmonth;
    $line .= "  $cweek\n"   if $cweek;
    $line .= "  $cday\n";
    $line .= "  $day\n";
    $line .= "  $tday\n";
    $line .= "  $tweek\n"   if $tweek;
    $line .= "  $tmonth\n"  if $tmonth;
    $line .= "  $tseason\n" if $tseason;
    $line .= "  $day\n";
    $line .= "  $uday\n";
    $line .= "  $uweek\n"   if $uweek;
    $line .= "  $umonth\n"  if $umonth;
    $line .= "  $useason\n" if $useason;
    $line .= " </tr>\n";
    push(@$lines, $line);
}

sub render_cal_line
{
    my ($track, $prev, $info, $type) = @_;
    my $suffix = substr($type, 0, 1);
    my $this   = $info->{"$type week"};
    my $prior  = $prev->{"$type week"};

    my $week = '';
    my $class = "day";
    $track->{"weekdur$suffix"} += 1;
    if ($this ne $prior)
    {
        if ($prior)
        {
            $class = "week break " . substr($type,0,3);
            $week =
              sprintf("<td rowspan='%d' class=\"%s\" style='background-color: %s'>%s</td>",
                      $track->{"weekdur$suffix"},
                      $class,
                      $prev->{"colorweek$suffix"},
                      $prev->{"$type week"});
        }
        $track->{"weekdur$suffix"} = 0;
    }
    $class = "day";
    $class .= " break" if $track->{"weekdur$suffix"} == 0;
    my $day =
      sprintf("<td class=\"%s\" style='background-color: %s'>%s</td>",
              $class, $prev->{"colorday$suffix"},
              $prev->{"$type day"});

    my $month = '';
    $this  = $info->{"$type month"};
    $prior = $prev->{"$type month"};
    $track->{"monthdur$suffix"} += 1;
    if ($this ne $prior)
    {
        my $fill = "";
        $class = "month break " . substr($type,0,3);
        if ($week eq "")
        {
            if ($track->{"monthdur$suffix"} > 1)
            {
                undef $fill;
            }
            else
            {
                $fill = ' colspan="3"';
                $day  = "";
                $class .= " day";
            }
        }
		if (defined $fill)
		{
	        $month =
	          sprintf("<td rowspan='%d'%s class=\"%s\" style='background-color: %s'>%s</td>",
	                  $track->{"monthdur$suffix"},
	                  $fill,
	                  $class,
	                  $prev->{"colormonth$suffix"},
	                  $prev->{"$type month"});
		}
        $track->{"monthdur$suffix"} = 0;
    }
    my $season = '';
    $this  = $info->{"$type season"};
    $prior = $prev->{"$type season"};
    $track->{"seasondur$suffix"} += 1;
    if ($this ne $prior)
    {
        my $fill = "";
        if ($month eq "")
        {
            $fill = ' colspan="3"';
        }
        $class = "season break " . substr($type,0,3);
        $season =
          sprintf("<td rowspan='%d'%s class=\"%s\" style='background-color: %s'>%s</td>",
                  $track->{"seasondur$suffix"},
				  $fill,
                  $class,
                  $prev->{"colorseason$suffix"},
                  $prev->{"$type season"});
        $track->{"seasondur$suffix"} = 0;    
    }
    return ($season,$month,$week,$day);
}

sub build_colors
{
    my ($colors, $seasons) = @_;
    my $day = 1;
    my @edges;
    push(@edges, [ 0, 0xdd, 0xdd, 0xdd ]);
    foreach my $info (@$seasons)
    {
        my $season = $info->{'name'};
        next if $season eq 'Calibration';
        my $rbg    = $info->{'rgb'};
        my $r      = hex(substr($rbg, 0, 2));
        my $g      = hex(substr($rbg, 2, 2));
        my $b      = hex(substr($rbg, 4, 2));
        my $months = $info->{'months'};
        my $drift  = 0x22;
        my $count  = @$months;
        my $each   = $drift / $count;
        my $offset = 0;

        foreach my $monthinfo (@$months)
        {
            $offset += $each;
            my $duration = $monthinfo->{'duration'};
            my $mid = int($day + ($duration / 2));
            push(@edges, [ $mid, $r - $offset, $g - $offset, $b - $offset ]);
            my $key = "month:$season:" . $monthinfo->{'name'};
            $colors->{$key} = sprintf("%02x%02x%02x", $r - $offset, $g - $offset, $b - $offset);
            $day += $duration;
        }
    }
    push(@edges, [ 420, 0xdd, 0xdd, 0xdd ]);
    push(@edges, [ 425, 0xdd, 0xdd, 0xdd ]);
    $colors->{"month:Calibration:"} = "dddddd";

    my $prev;
    $day = 1;
    foreach my $edge (@edges)
    {
        if (defined $prev)
        {
            my ($eday, $er, $eg, $eb) = @$edge;
            my ($pday, $pr, $pg, $pb) = @$prev;
            while ($day < $eday)
            {
                my $range   = $eday - $pday;
                my $offset  = $eday - $day;
                my $percent = $offset / $range;

                $range = $er - $pr;
                my $r = int($er - ($range * $percent));

                $range = $eg - $pg;
                my $g = int($eg - ($range * $percent));

                $range = $eb - $pb;
                my $b = int($eb - ($range * $percent));

                $colors->{$day} = sprintf("%02x%02x%02x", $r, $g, $b);
                $day += 1;
            }
            $colors->{$eday} = sprintf("%02x%02x%02x", $er, $eg, $eb);
            $day += 1;
        }
        $prev = $edge;
    }
}