ESyntax10.Scn.Fnt$InfoElemsAllocvSyntax10.Scn.Fnt+StampElemsAlloc30 Jun 98sSyntax10i.Scn.Fnt^f"Title": Dates "Author": Andreas Krumenacker "Abstract": Dates ... "Keywords": date, dates, calendar "Version": 1.0 "From": 9 Apr 98 "Until":  "Changes": no changes so far "Hints": To support another language e.g. for the names of months, extend the type Date and overwrite the type-bound procedures: date.MonthName (short : BOOLEAN; VAR name : ARRAY OF CHAR) date.DayName (short : BOOLEAN; VAR name : ARRAY OF CHAR) date.YearExt (VAR ext : ARRAY OF CHAR) date.DayExt (VAR ext : ARRAY OF CHAR) You might also need to overwrite the type-bound procedure: date.CopyTo (copy : Dates.Date) Don't forget to call the inherited method in this case. If the extended type adds new fields, also overwrite the type-bound procedures: date.Store (VAR r : Files.Rider) date.Load (VAR r : Files.Rider) Don't forget to call the inherited methods in this case.38FoldElemsNewSyntax10.Scn.FntSyntax10i.Scn.FntSyntax10m.Scn.Fnt 8FoldElemsNewSyntax10m.Scn.FntSyntax10i.Scn.FntWebElemsAllocTag/FONT(/FONTDFONT SIZE=+2/FONTu Astronomers have standardized a conventional way of denoting dates, to simplify long range calculations. By this method days are identified in reference to an unbroken count begun on January 1st, 4713 B.C. As there was no unique calendar in use at these days, the Julian calendar ist taken. The Julian calendar was established by Julius Caesar in 46 B.C., which was the year 709 of the Roman Empire: It made the year-count more accurate by adding an extra day every 4th year, thus approximating the solar year to 365,25 days. The extra day was probably not officially used until 8 A.D., during the reign of Augustus. One year consists of 12 month. The months 1, 3, 5, 7, 8, 10 and 12 have 31 days and the months 4, 6, 9 and 11 have 30 days. The 2nd month consists of 28 days increased every 4th year (leap-year) by an extra day. The expansion of the Roman Empire in the subsequent centuries made this calendar widely recognized. The system of numbering years by A.D. designation (Anno Domini) was instituted in 525 A.D. by the Roman abbot Dionysius Exiguus. Since the Julian calendar is still slightly inaccurate, a discrepency built up over the centuries, causing problems in determining the occurrence of Easter. (365,25 days instead of 365,2422 days of a solar year) By the 16th Century, Easter was slipping towards summer. The problem was resolved by Pope Gregory XIII in 1582. (Gregorian calendar) The reform resynchronized the time-count with respect to the equinoxes by skipping ten days. In other words, October 4th of 1582 was followed by October 15th. However, the sequential cycling of the day-names of the week was not broken. The rule for leap year was also changed. In the new Gregorian calendar a year which is divisible by 4 is a leap-year unless it is divisible by 100 but not by 400. Thus, 1700, 1800, 1900 and 2100 are not leap-years. Therefore the solar year was approximated to 365,2425 days. January 1st, 300 A.D. is taken as reference-day, because the Julian as well as the Gregorian calendar show the same date at this day. (From March 1st, 200 A.D. to February 28th, 300 A.D. both calendars are synchronized.) 8 8Syntax10m.Scn.FntSyntax10i.Scn.Fnt"iParcElemsAlloc+W IiR  String Converted to Examples (defaultCal) 1.1.1998 24.12.-1998 Y signed year 1998 -1998 YY signed year (2 digits) 98 -98 YYY unsigned year 1998 1999 YYYY... signed year (4 digits) 1998 -1998 y... B.C. / A.D. B.C. A.D. M month 1 24 MM month (2 digits) 01 24 MMM short name of month Jan Dec MMMM... name of month January December D day 1 12 DD day (2 digits) 01 12 DDD short name of day Thu Sun DDDD... name of day Thursday Sunday d... day-ending st th (1st, 2nd, 3rd, 4th, ...) W week of year 1 51 WW... week of year (2 digits) 01 51 % the following character is not for formating purposes  Any other Character is put into the destination-string. Example: The formating-string "To%da%y is DDDD the Dd of MMMM in the %year YYY y" applied for January 1st, 1998 A.D. leads to "Today is Thursday the 1st of January in the year 1998 A.D." 8 8=Syntax10m.Scn.FntSyntax10i.Scn.Fnt13 An important point is that -4712 is written 4713 B.C. In other words, astronomers recognize a 0 year for calculational purposes, whereas historians do not. There was never a "zero" year. Therefore, -3113 is the same as 3114 B.C.; a given negative year number is always one less than its B.C. equivalent. 8,(* General:  Formating:  Comment:  *)Syntax10i.Scn.Fnt 8 8_Syntax10.Scn.FntSyntax10b.Scn.Fnt    defaultCal* = 0; gregorianCal* = 1; julianCal* = 2; cals = 3; refY = 300; refWD = 6; initY = - 4712; gregY = 1582; gregM = 10; gregD = 15; julD = 4; gregDiff = 10; beforeChrist = "B.C."; afterChrist = "A.D."; 88Syntax10.Scn.FntSyntax10b.Scn.Fnt8FoldElemsNew #8u Date* = POINTER TO DateDesc;  DateDesc* = RECORD day-, month-, year-, cal- : INTEGER; ref : LONGINT; END; 8n8#Syntax10.Scn.Fntpp initRef : LONGINT; mName : ARRAY 12, 32 OF CHAR; dName : ARRAY 7, 32 OF CHAR; dExt : ARRAY 4, 32 OF CHAR; 8118#Syntax10.Scn.Fnt BEGIN IF (cal = julianCal) OR ((cal = defaultCal) & (y <= gregY)) THEN RETURN y MOD 4 = 0 ELSE RETURN ((y MOD 4 = 0) & (y MOD 100 # 0)) OR (y MOD 400 = 0) END END IsLeap;83?8#Syntax10.Scn.Fnt VAR d : INTEGER; BEGIN d := 365; IF IsLeap(y, cal) THEN INC(d) ELSIF (cal = defaultCal) & (y = gregY) THEN DEC(d, gregDiff) END; RETURN d END YearDays;8G8#Syntax10.Scn.Fnt## VAR d : INTEGER; BEGIN d := 31; IF ~ last & (cal = defaultCal) & (y = gregY) & (m = gregM) THEN DEC(d, gregDiff) END; IF m > 2 THEN m := (m - 3) MOD 5; IF ODD(m) THEN DEC(d) END ELSIF m = 2 THEN IF IsLeap(y, cal) THEN DEC(d, 2) ELSE DEC(d, 3) END END; RETURN d END MonthDays;8/k8CSyntax10.Scn.FntSyntax10i.Scn.Fnt9S (* 0..6 => monday..sunday *) BEGIN RETURN SHORT((ref + refWD) MOD 7) END WeekDay;868QSyntax10.Scn.FntSyntax10i.Scn.Fntq VAR d : LONGINT; BEGIN d := LONG(365) * (y - refY); IF y >= refY THEN DEC(y); IF (cal = defaultCal) & (y >= gregY) THEN DEC(d, gregDiff) END; WHILE (y >= refY) & ~ IsLeap(y, cal) DO DEC(y) END; (* adjust to leap-year *) WHILE y >= refY DO IF IsLeap(y, cal) THEN INC(d) END; DEC(y, 4) END ELSE WHILE (y < refY) & ~ IsLeap(y, cal) DO INC(y) END; (* adjust to leap-year *) WHILE y < refY DO IF IsLeap(y, cal) THEN DEC(d) END; INC(y, 4) END END; RETURN d END DaysUp2Year;8:V8#Syntax10.Scn.Fnt VAR d : INTEGER; BEGIN DEC(m); d := 0; WHILE m > 0 DO INC(d, MonthDays(m, y, cal, FALSE)); DEC(m) END; RETURN d END DaysUp2Month;8Syntax10b.Scn.Fntm8#Syntax10.Scn.Fntqq BEGIN date.day := 1; date.month := 1; date.year := initY; date.ref := initRef; date.cal := defaultCal END Init;838#Syntax10.Scn.Fnt BEGIN IF copy = NIL THEN NEW(copy) END; copy.day := date.day; copy.month := date.month; copy.year := date.year; copy.ref := date.ref; copy.cal := date.cal END CopyTo;88#Syntax10.Scn.Fnt11 BEGIN RETURN other.ref - date.ref END DaysUpTo;8 8#Syntax10.Scn.Fnt22 BEGIN RETURN date.ref > other.ref END LaterThan;8 r8CSyntax10.Scn.FntSyntax10i.Scn.Fnt2L (* 0..6 => monday..sunday *) BEGIN RETURN WeekDay(date.ref) END DayOfWeek;8 98{Syntax10.Scn.FntSyntax10i.Scn.Fnta!5^Q$vM (* return values 1..53 *) VAR cw : INTEGER; ref, sun : LONGINT; BEGIN sun := date.ref - WeekDay(date.ref) - 1; (* sunday of the dates previous week *) ref := DaysUp2Year(date.year + 1, date.cal); (* last day of the dates year *) IF ref - sun < 4 THEN cw := 1 ELSE ref := ref - YearDays(date.year, date.cal) + 1; (* first day of the dates year *) IF ref - sun > 4 THEN ref := ref - YearDays(date.year - 1, date.cal) (* first day of the dates previous year *) END; cw := SHORT(sun - ref) DIV 7 + 1; IF WeekDay(ref) < 4 THEN INC(cw) END END; RETURN cw END WeekOfYear;8 8#Syntax10.Scn.Fnt:: BEGIN RETURN IsLeap(date.year, date.cal) END IsLeapYear;8 8#Syntax10.Scn.FntQQ BEGIN RETURN MonthDays(date.month, date.year, date.cal, FALSE) END DaysOfMonth;8'8#Syntax10.Scn.Fnt BEGIN date.ref := DaysUp2Year(date.year, date.cal) + DaysUp2Month(date.month, date.year, date.cal) + date.day; IF (date.cal = defaultCal) & (date.year = gregY) & (date.month = gregM) & (date.day >= gregD) THEN DEC(date.ref, gregDiff) END END ComputeDays;8'8QSyntax10.Scn.FntSyntax10i.Scn.Fnt$%& VAR ref, x : LONGINT; n : INTEGER; BEGIN ref := date.ref; date.year := SHORT((ref - 1) DIV 366) + refY; x := DaysUp2Year(date.year, date.cal); IF ref > 0 THEN n := YearDays(date.year, date.cal); WHILE ref - x > n DO INC(date.year); INC(x, LONG(n)); n := YearDays(date.year, date.cal) END ELSE WHILE ref - x <= 0 DO DEC(date.year); DEC(x, LONG(YearDays(date.year, date.cal))) END END; DEC(ref, x); (* assert: 0 < d <= YearDays(date.year) *) date.month := SHORT(ref DIV 32) + 1; x := DaysUp2Month(date.month, date.year, date.cal); n := MonthDays(date.month, date.year, date.cal, FALSE); WHILE ref - x > n DO INC(date.month); INC(x, LONG(n)); n := MonthDays(date.month, date.year, date.cal, FALSE) END; DEC(ref, x); (* assert: 0 < d <= MonthDays(date.month) *) date.day := SHORT(ref); IF (date.cal = defaultCal) & (date.year = gregY) & (date.month = gregM) & (date.day > julD) THEN INC(date.day, gregDiff) END END ComputeDate;88#Syntax10.Scn.Fnt>> BEGIN date.cal := cal MOD cals; date.ComputeDate END SetCal;8 8#Syntax10.Scn.Fnt BEGIN date.day := ABS(day); date.month := ABS(month); date.year := year; INC(date.year, (date.month - 1) DIV 12); date.month := (date.month - 1) MOD 12 + 1; date.ComputeDays; date.ComputeDate END Set;8 8CSyntax10.Scn.FntSyntax10i.Scn.Fnt i VAR day, month, year : INTEGER; BEGIN date.year := SHORT(d DIV 512 MOD 128) + 1900; IF date.year < 1904 THEN INC(date.year, 100) END; (* mac specific *) date.month := SHORT(d DIV 32 MOD 16); date.day := SHORT(d MOD 32); date.ComputeDays END SetToDate;88#Syntax10.Scn.FntAA BEGIN date.ref := ref + initRef; date.ComputeDate END SetToRef;88#Syntax10.Scn.Fnt VAR d, t : LONGINT; cal : INTEGER; BEGIN Oberon.GetClock(t, d); IF date.cal # defaultCal THEN cal := date.cal; date.cal := defaultCal; date.SetToDate(d); date.SetCal(cal) ELSE date.SetToDate(d) END END SetToday;88#Syntax10.Scn.FntOO BEGIN RETURN LONG(date.year MOD 100)*512 + date.month*32 + date.day END Date;88#Syntax10.Scn.Fnt** BEGIN RETURN date.ref - initRef END Ref;8,8#Syntax10.Scn.FntHH BEGIN trackUltimo := trackUltimo & (date.day = MonthDays(date.month, date.year, date.cal, TRUE)); INC(date.year, years); IF trackUltimo OR (date.day > MonthDays(date.month, date.year, date.cal, TRUE)) THEN date.day := MonthDays(date.month, date.year, date.cal, TRUE) END; date.ComputeDays; date.ComputeDate END AddYears;8 -N8#Syntax10.Scn.Fnt BEGIN trackUltimo := trackUltimo & (date.day = MonthDays(date.month, date.year, date.cal, TRUE)); INC(months, date.month - 1); date.month := months MOD 12 + 1; INC(date.year, months DIV 12); IF trackUltimo OR (date.day > MonthDays(date.month, date.year, date.cal, TRUE)) THEN date.day := MonthDays(date.month, date.year, date.cal, TRUE) END; date.ComputeDays; date.ComputeDate END AddMonths;88#Syntax10.Scn.Fnt:: BEGIN INC(date.ref, days); date.ComputeDate END AddDays;8 /8#Syntax10.Scn.FntZZ BEGIN COPY(mName[date.month - 1], name); IF short THEN name[3] := 0X END END MonthName;8/8#Syntax10.Scn.FntZZ BEGIN COPY(dName[date.DayOfWeek()], name); IF short THEN name[3] := 0X END END DayName;8|8#Syntax10.Scn.Fntbb BEGIN IF date.year > 0 THEN COPY(afterChrist, ext) ELSE COPY(beforeChrist, ext) END END YearExt;8M8#Syntax10.Scn.Fnt VAR dig : INTEGER; BEGIN dig := date.day MOD 10; IF (dig > 3) OR (date.day DIV 10 = 1) THEN dig := 0 END; COPY(dExt[dig], ext) END DayExt;8S!8/Syntax10.Scn.FntE*8FoldElemsNew#Syntax10.Scn.Fnt VAR val : LONGINT; i, j : INTEGER; BEGIN i := SHORT(LEN(str)) -1; val := ABS(LONG(int)); str[i] := 0X; DEC(i); REPEAT str[i] := CHR(30H + val MOD 10); val := val DIV 10; DEC(i); DEC(digs) UNTIL (val = 0) OR (digs = 0); WHILE digs > 0 DO str[i] := "0"; DEC(i); DEC(digs) END; IF int < 0 THEN str[i] := "-" ELSE INC(i) END; j := i - 1; REPEAT INC(j); str[j-i] := str[j] UNTIL str[j] = 0X END Int2Str;8j PROCEDURE Int2Str (int, digs : INTEGER; VAR str : ARRAY OF CHAR);  BEGIN IF times < 2 THEN times := 0 END; CASE ch OF "Y" : IF times = 3 THEN IF date.year > 0 THEN Int2Str(date.year, 0, s) ELSE Int2Str(1 - date.year, 0, s) END ELSE IF times > 4 THEN times := 4 END; Int2Str(date.year, times, s) END | "y" : date.YearExt(s) | "M" : IF times > 2 THEN date.MonthName(times = 3, s) ELSE Int2Str(date.month, times, s) END | "W" : IF times > 2 THEN times := 2 END; Int2Str(date.WeekOfYear(), times, s) | "D" : IF times > 2 THEN date.DayName(times = 3, s) ELSE Int2Str(date.day, times, s) END | "d" : date.DayExt(s) ELSE s[0] := 0X END END Get;8.8#Syntax10.Scn.Fnt00 VAR i, j, n, max : INTEGER; ch : CHAR; s : ARRAY 32 OF CHAR; BEGIN i := 0; j := 0; ch := 0X; max := SHORT(LEN(d)) - 1; REPEAT IF (CAP(f[i]) = "Y") OR (f[i] = "M") OR (f[i] = "W") OR (CAP(f[i]) = "D") THEN n := 1; ch := f[i]; INC(i); WHILE ch = f[i] DO INC(n); INC(i) END; date.Get(ch, n, s); n := 0; WHILE (s[n] # 0X) & (j < max) DO d[j] := s[n]; INC(j); INC(n) END ELSE IF f[i] = "%" THEN INC(i) END; ch := f[i]; INC(i); IF j < max THEN d[j] := ch; INC(j) END END UNTIL (ch = 0X) OR (j >= max); d[max] := 0X END Format;88#Syntax10.Scn.FntLL BEGIN Files.WriteInt(r, date.cal); Files.WriteLInt(r, date.ref) END Store;88#Syntax10.Scn.Fnt[[ BEGIN Files.ReadInt(r, date.cal); Files.ReadLInt(r, date.ref); date.ComputeDate END Load;8q8#Syntax10.Scn.Fntmm BEGIN initRef := DaysUp2Year(initY, defaultCal) + DaysUp2Month(1, initY, defaultCal) + 1; mName[0] := "January"; mName[1] := "February"; mName[2] := "March"; mName[3] := "April"; mName[4] := "May"; mName[5] := "June"; mName[6] := "July"; mName[7] := "August"; mName[8] := "September"; mName[9] := "October"; mName[10] := "November"; mName[11] := "December"; dName[0] := "Monday"; dName[1] := "Tuesday"; dName[2] := "Wednesday"; dName[3] := "Thursday"; dName[4] := "Friday"; dName[5] := "Saturday"; dName[6] := "Sunday"; dExt[0] := "th"; dExt[1] := "st"; dExt[2] := "nd"; dExt[3] := "rd" END Init;88#Syntax10.Scn.Fnt Init8 QMODULE Dates;  Explanations IMPORT Oberon, Files; CONST  TYPE  VAR  PROCEDURE IsLeap (y, cal : INTEGER) : BOOLEAN;  PROCEDURE YearDays (y, cal : INTEGER) : INTEGER;  PROCEDURE MonthDays (m, y, cal : INTEGER; last : BOOLEAN) : INTEGER;  PROCEDURE WeekDay (ref : LONGINT) : INTEGER;  PROCEDURE DaysUp2Year (y, cal : INTEGER) : LONGINT;  PROCEDURE DaysUp2Month (m, y, cal : INTEGER) : INTEGER;  PROCEDURE (date : Date) Init*;  PROCEDURE (date : Date) CopyTo* (copy : Date);  PROCEDURE (date : Date) DaysUpTo* (other : Date) : LONGINT;  PROCEDURE (date : Date) LaterThan* (other : Date) : BOOLEAN;  PROCEDURE (date : Date) DayOfWeek* () : INTEGER;  PROCEDURE (date : Date) WeekOfYear* () : INTEGER;  PROCEDURE (date : Date) IsLeapYear* () : BOOLEAN;  PROCEDURE (date : Date) DaysOfMonth* () : INTEGER;  PROCEDURE (date : Date) ComputeDays;  PROCEDURE (date : Date) ComputeDate;  PROCEDURE (date : Date) SetCal* (cal : INTEGER);  PROCEDURE (date : Date) Set* (day, month, year : INTEGER);  PROCEDURE (date : Date) SetToDate* (d : LONGINT);  PROCEDURE (date : Date) SetToRef* (ref : LONGINT);  PROCEDURE (date : Date) SetToday*;  PROCEDURE (date : Date) Date* () : LONGINT;  PROCEDURE (date : Date) Ref* () : LONGINT;  PROCEDURE (date : Date) AddYears* (years : INTEGER; trackUltimo : BOOLEAN);  PROCEDURE (date : Date) AddMonths* (months : INTEGER; trackUltimo : BOOLEAN);  PROCEDURE (date : Date) AddDays* (days : LONGINT);  PROCEDURE (date : Date) MonthName* (short : BOOLEAN; VAR name : ARRAY OF CHAR);  PROCEDURE (date : Date) DayName* (short : BOOLEAN; VAR name : ARRAY OF CHAR);  PROCEDURE (date : Date) YearExt* (VAR ext : ARRAY OF CHAR);  PROCEDURE (date : Date) DayExt* (VAR ext : ARRAY OF CHAR);  PROCEDURE (date : Date) Get (ch : CHAR; times : INTEGER; VAR s : ARRAY OF CHAR);  PROCEDURE (date : Date) Format* (f : ARRAY OF CHAR; VAR d : ARRAY OF CHAR);  PROCEDURE (date : Date) Store* (VAR r : Files.Rider);  PROCEDURE (date : Date) Load* (VAR r : Files.Rider);  PROCEDURE Init;  BEGIN  END Dates.