# -----------------------------------------------------------------------------
# $Id$
# -----------------------------------------------------------------------------
# マヤ歴を扱うためのクラスです。
# GNU Emacsのcalendar.el及びcal-mayan.elの一部をperlに移植したものです。
# このスクリプトはPDSです。
# -----------------------------------------------------------------------------
# my $m = MayanDate->new;
# print $m->mayan_date_string;
#
# 出力: Long Count = 12.19.10.5.16; tzolkin = 4 Cib; haab = 4 Zotz
# -----------------------------------------------------------------------------
package MayanDate;
use strict;
use warnings;

our $mayan_days_before_absolute_zero = 1137142;
# グレゴリオ歴 12/31/1 BC を`absolute day 0'とする。
# マヤ歴におけるエポックが、absolute day 0から何日前であったか。
# これは Goodman-Martinez-Thompson の説であり、広く使われているものであるが、
# 1137140を使う者も居る。 1232041が Spinden の説であり、1142840が
# Hochleitner の説である。

our $haab_at_epoch = [8,18];
# マヤン・エポックにおけるハアブ歴

our $haab_names_array =
  [qw/Pop Uo Zip Zotz Tzec Xul Yaxkin Mol Chen Yax
      Zac Ceh Mac Kankin Muan Pax Kayab Cumku/];

our $tzolkin_at_epoch = [4,20];
# マヤン・エポックにおけるツォルキン歴

our $tzolkin_names_array =
  [qw/Imix Ik Akbal Kan Chicchan Cimi Manik Lamat Muluc Oc
      Chuen Eb Ben Ix Men Cib Caban Etznab Cauac Ahau/];

sub new {
    # new($epoch_sec)
    #   $epoch_sec: グレコリアン・エポック(1970年1月1日0時0分0秒)からの経過秒数。
    #               省略されたら、その時の時刻を使用する。
    #
    # new($year,$month,$day)
    #   $year:  グレゴリオ歴における年
    #   $month: 同月
    #   $day:   同日
    my $class = shift;
    my ($year,$month,$day) = do {
	if (@_ == 3) {
	    @_;
	}
	else {
	    my $epoch_sec = sub{defined$_[0]?$_[0]:time}->(shift);
	    my ($y,$m,$d) = (localtime($epoch_sec))[5,4,3];
	    $y += 1900;
	    $m++;
	    ($y,$m,$d);
	}
    };
    my $this = {
	year => $year,
	month => $month,
	day => $day,
    };
    bless $this,$class;
}

sub leap_year_p {
    # この年がグレゴリオ歴における閏年かどうか。
    my $this = shift;
    ($this->{year} % 4 == 0) &&
	($this->{year} % 100 != 0 || ($this->{year} % 400 == 0));
}

sub day_number {
    # この日が、その年における何日目の日であるか。
    # 例えば1987年1月1日は`1'、1980年12月31日は`366'
    my $this = shift;
    my $day_of_year = $this->{day} + (31 * ($this->{month} - 1));
    if ($this->{month} > 2) {
	$day_of_year -= int((23 + 4 * $this->{month}) / 10);
	if ($this->leap_year_p) {
	    $day_of_year++;
	}
    }
    $day_of_year;
}

sub absolute_from_gregorian {
    # グレゴリオ歴 12/31/1 BC からの経過日数を求める。
    # グレゴリオ歴 Sunday, December 31, 1 BC は実在しない。
    # (The Gregorian date Sunday, December 31, 1 BC is imaginary.)
    my $this = shift;
    my $prior_years = $this->{year} - 1;
    $this->day_number +                # Days this year
	(365 * $prior_years) +         # + Days in prior years
	int($prior_years / 4) +        # + Julian leap years
	-1 * int($prior_years / 100) + # - century years
	int($prior_years / 400);
}

sub mod {
    # Non-negative remainder of M/N with N instead of 0.
    my ($m,$n) = @_;
    1 + (($m - 1) % $n);
}

sub long_count {
    # この日のロングカウントを求める。
    my $this = shift;
    my $long_count = $this->absolute_from_gregorian + $mayan_days_before_absolute_zero;
    my $baktun = int($long_count / 144000);
    my $remainder = $long_count % 144000;
    my $katun = int($remainder / 7200);
    $remainder %= 7200;
    my $tun = int($remainder / 360);
    $remainder %= 360;
    my $uinal = int($remainder / 20);
    my $kin = $remainder % 20;
    [$baktun,$katun,$tun,$uinal,$kin];
}

sub haab {
    # この日のハアブ歴を求める。
    my $this = shift;
    my $long_count = $this->absolute_from_gregorian + $mayan_days_before_absolute_zero;
    my $day_of_haab = ($long_count +
			 $haab_at_epoch->[0] +
			   20 * ($haab_at_epoch->[1] - 1)) % 365;
    my $day = $day_of_haab % 20;
    my $month = int($day_of_haab / 20 + 1);
    [$day,$month];
}

sub tzolkin {
    # この日のツォルキン歴を求める。
    my $this = shift;
    my $long_count = $this->absolute_from_gregorian + $mayan_days_before_absolute_zero;
    my $day = &mod($long_count + $tzolkin_at_epoch->[0],13);
    my $name = &mod($long_count + $tzolkin_at_epoch->[1],20);
    [$day,$name];
}

sub long_count_to_string {
    # ロングカウントを文字列へ。
    my $long_count = shift;
    sprintf('%s.%s.%s.%s.%s',@$long_count);
}

sub tzolkin_to_string {
    # ツォルキン歴を文字列へ。
    my $tzolkin = shift;
    sprintf('%d %s',$tzolkin->[0],$tzolkin_names_array->[$tzolkin->[1] - 1]);
}

sub haab_to_string {
    # ハアブ歴を文字列へ。
    my $haab = shift;
    my $month = $haab->[1];
    my $day = $haab->[0];
    # 第19の月には、5日間の凶日がある。
    if ($month == 19) {
	sprintf('%d Uayeb',$day);
    }
    else {
	sprintf('%d %s',$day,$haab_names_array->[$month - 1]);
    }
}

sub mayan_date_string {
    # この日のロングカウント・ツォルキン歴・ハアブ歴を文字列へ。
    my $this = shift;
    my $tzolkin = $this->tzolkin;
    my $haab = $this->haab;
    my $long_count = $this->long_count;
    sprintf('Long Count = %s; tzolkin = %s; haab = %s',
	    &long_count_to_string($long_count),
	    &tzolkin_to_string($tzolkin),
	    &haab_to_string($haab));
}

1;