a580e12000-09-27Fredrik Hübinette (Hubbe) #pike __REAL_VERSION__
a20af62000-09-26Fredrik Hübinette (Hubbe) 
5479552003-03-13Martin Nilsson //! This is the standard western calendar, which is a derivate //! of the Gregorian calendar, but with weeks that starts on //! Monday instead of Sunday.
9f0b6c2008-02-07Martin Stjernholm inherit Calendar.Gregorian:Gregorian;
78fd532000-07-12Mirar (Pontus Hagland) 
489a702001-01-11Mirar (Pontus Hagland) #include "constants.h"
78fd532000-07-12Mirar (Pontus Hagland) string calendar_name() { return "ISO"; }
22b33a2001-06-17Mirar (Pontus Hagland) #define WEEK_MAJORITY 4
9eaf1d2008-06-28Martin Nilsson private protected mixed __initstuff=lambda()
5550a21998-01-27Mirar (Pontus Hagland) {
78fd532000-07-12Mirar (Pontus Hagland)  f_week_day_shortname_from_number="week_day_shortname_from_number"; f_week_day_name_from_number="week_day_name_from_number"; f_year_name_from_number="year_name_from_number"; f_week_day_number_from_name="week_day_number_from_name"; }();
071d021998-09-27Mirar (Pontus Hagland) 
9eaf1d2008-06-28Martin Nilsson protected int compat_week_day(int n)
7d6bbc1999-02-13Fredrik Noring {
78fd532000-07-12Mirar (Pontus Hagland)  return n%7;
7d6bbc1999-02-13Fredrik Noring }
5550a21998-01-27Mirar (Pontus Hagland) 
9eaf1d2008-06-28Martin Nilsson protected string year_name_from_number(int y)
78fd532000-07-12Mirar (Pontus Hagland) { if (y>0) return ""+y; else return (1-y)+" BC";
5550a21998-01-27Mirar (Pontus Hagland) }
9eaf1d2008-06-28Martin Nilsson protected array(int) week_from_julian_day(int jd)
5550a21998-01-27Mirar (Pontus Hagland) {
22b33a2001-06-17Mirar (Pontus Hagland) // [week-year,week,day-of-week,ndays,week-julian-day]
5550a21998-01-27Mirar (Pontus Hagland) 
78fd532000-07-12Mirar (Pontus Hagland)  [int y,int yjd]=year_from_julian_day(jd); int yday=jd-yjd+1;
22b33a2001-06-17Mirar (Pontus Hagland)  int wjd=jd-jd%7;
7d6bbc1999-02-13Fredrik Noring 
22b33a2001-06-17Mirar (Pontus Hagland) #if 1 int k=WEEK_MAJORITY+(yjd-WEEK_MAJORITY)%7;
78fd532000-07-12Mirar (Pontus Hagland)  int w=(yday+k-1)/7;
22b33a2001-06-17Mirar (Pontus Hagland)  // werror("wjd %d: %O %O %O, %O %O %O\n",jd,y,yjd,yday,k,w,wjd);
7d6bbc1999-02-13Fredrik Noring 
78fd532000-07-12Mirar (Pontus Hagland)  if (!w)
7d6bbc1999-02-13Fredrik Noring  {
78fd532000-07-12Mirar (Pontus Hagland) // handle the case that the day is in the previous year; // years previous to years staring on saturday, // ... and leap years starting on sunday
22b33a2001-06-17Mirar (Pontus Hagland) 
78fd532000-07-12Mirar (Pontus Hagland)  y--;
22b33a2001-06-17Mirar (Pontus Hagland)  w=52+( (k==WEEK_MAJORITY) || ( (k==WEEK_MAJORITY+1) && year_leap_year(y) ) );
7d6bbc1999-02-13Fredrik Noring  }
22b33a2001-06-17Mirar (Pontus Hagland)  else if (w==53 && k>=5-year_leap_year(y) && k<10-year_leap_year(y))
5550a21998-01-27Mirar (Pontus Hagland)  {
78fd532000-07-12Mirar (Pontus Hagland) // handle the case that the week is in the next year y++; w=1;
5550a21998-01-27Mirar (Pontus Hagland)  }
7d6bbc1999-02-13Fredrik Noring 
22b33a2001-06-17Mirar (Pontus Hagland) #else // Calendar FAQ algorithm (Stefan Potthast): // not used, does not calculate the week-year int d4 = (jd+31741 - (jd %7))%146097 %36524 %1461; int L = d4/1460; int d1 = ((d4-L) % 365) + L; int w = d1/7 + 1; // werror("wjd %d: %O %O %O, %O\n",jd,y,yjd,yday,wjd,w); #endif // werror("wjd %d: = %d, %d, %d, %d, %d\n", // jd,@({y,w,1+(yjd+yday-1)%7,7,wjd}));
78fd532000-07-12Mirar (Pontus Hagland)  return ({y,w,1+(yjd+yday-1)%7,7,wjd});
7d6bbc1999-02-13Fredrik Noring }
9eaf1d2008-06-28Martin Nilsson protected array(int) week_from_week(int y,int w)
7d6bbc1999-02-13Fredrik Noring {
3661132008-05-23Martin Stjernholm // [week-year,week,1 (wd),ndays,week-julian-day]
7d6bbc1999-02-13Fredrik Noring 
78fd532000-07-12Mirar (Pontus Hagland)  int yjd=julian_day_from_year(y);
22b33a2001-06-17Mirar (Pontus Hagland)  int wjd=-WEEK_MAJORITY+yjd-(yjd+WEEK_MAJORITY-1)%7; // werror("bip %O %O: %O %O\n",y,w,yjd,wjd);
7d6bbc1999-02-13Fredrik Noring 
78fd532000-07-12Mirar (Pontus Hagland)  if (w<1 || w>52) // may or may not be out of this year return week_from_julian_day(wjd+w*7);
7d6bbc1999-02-13Fredrik Noring 
78fd532000-07-12Mirar (Pontus Hagland)  return ({y,w,1,7,wjd+w*7}); // fixme
7d6bbc1999-02-13Fredrik Noring }
78fd532000-07-12Mirar (Pontus Hagland) class cYear
7d6bbc1999-02-13Fredrik Noring {
78fd532000-07-12Mirar (Pontus Hagland)  inherit Gregorian::cYear; TimeRange place(TimeRange what,void|int force)
7d6bbc1999-02-13Fredrik Noring  {
78fd532000-07-12Mirar (Pontus Hagland)  if (what->is_day) { int wyd=what->yd; if (md==CALUNKNOWN) make_month(); if (wyd>=55) { int l1=year_leap_year(what->y); int l2=year_leap_year(y);
3661132008-05-23Martin Stjernholm  if (l1 != l2)
78fd532000-07-12Mirar (Pontus Hagland)  {
3661132008-05-23Martin Stjernholm  // (Apparently) the leap day was moved from February 24th to // 29th on year 2000 in the ISO calendar. // // This code was overly clever and enforced that move by mapping // the 24th in leap years before 2000 to 29th in 2000 and // following leap years. That leads to nonlinear behavior, i.e. // // Day(y1,m1,d1) <= Day(y2,m2,d2) // ===> // Day(y1,m1,d1) + n*Year() <= Day(y2,m2,d2) + n*Year() // // wasn't always true in the ISO calendar. That's bad when doing // date arithmetic. // // That has now been fixed by simply mapping all days one-to-one // between leap years, regardless whether they're before 2000 or // not. // // The exact date for the leap day still has effect when // converting between leap and non-leap years, though. // // /mast if (l1) { int ld1=(what->y<2000)?55:60; // 24th or 29th february if (wyd>ld1) wyd--; else if (wyd==ld1) { if (force) wyd--; // Lossy case - prefer to keep the month. else return 0; } } else { int ld2=(y<2000)?55:60; // 24th or 29th february if (wyd>=ld2) wyd++;
78fd532000-07-12Mirar (Pontus Hagland)  } } } if (!force && wyd>number_of_days()) return 0; return Day("ymd_yd",rules,y,yjd,yjd+wyd-1,wyd,what->n); }
7d6bbc1999-02-13Fredrik Noring 
3661132008-05-23Martin Stjernholm  return ::place(what, force);
7d6bbc1999-02-13Fredrik Noring  } }
78fd532000-07-12Mirar (Pontus Hagland) class cMonth
7d6bbc1999-02-13Fredrik Noring {
78fd532000-07-12Mirar (Pontus Hagland)  inherit Gregorian::cMonth;
7d6bbc1999-02-13Fredrik Noring 
78fd532000-07-12Mirar (Pontus Hagland)  TimeRange place(TimeRange what,int|void force)
7d6bbc1999-02-13Fredrik Noring  {
78fd532000-07-12Mirar (Pontus Hagland)  if (what->is_day) { int wmd=what->month_day(); if (md==CALUNKNOWN) make_month(); if (what->m==2 && m==2 && wmd>=24) { int l1=year_leap_year(what->y); int l2=year_leap_year(y);
3661132008-05-23Martin Stjernholm  if (l1 != l2)
78fd532000-07-12Mirar (Pontus Hagland)  {
3661132008-05-23Martin Stjernholm  // See note above about leap day mapping. if (l1) { int ld1=(what->y<2000)?24:29; // 24th or 29th february if (wmd>ld1) wmd--; else if (wmd==ld1) { if (force) wmd--; // Lossy case - prefer to keep the month. else return 0; } }
78fd532000-07-12Mirar (Pontus Hagland)  else {
3661132008-05-23Martin Stjernholm  int ld2=(y<2000)?24:29; // 24th or 29th february if (wmd>=ld2) wmd++;
78fd532000-07-12Mirar (Pontus Hagland)  } } } if (!force && wmd>number_of_days()) return 0; return Day("ymd_yd",rules,y,yjd,jd+wmd-1,yd+wmd-1,what->n); }
7d6bbc1999-02-13Fredrik Noring 
3661132008-05-23Martin Stjernholm  return ::place(what, force);
7d6bbc1999-02-13Fredrik Noring  } }