1(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich. 2Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *) 3 4MODULE ethDates; (** portable *) (* PS *) 5 6IMPORT Texts; 7 8CONST 9 minute* = 60; hour* = 60*minute; day* = 24*hour; week*= 7* day; 10 zeroY = 1900; 11 firstY* = 1901; 12 13VAR 14 TimeDiff*: LONGINT; (** local difference to universal time in minutes *) 15 A : ARRAY 13 OF INTEGER; 16 T : ARRAY 365 OF SHORTINT; 17 18(** Returns TRUE if year is a leap year *) 19PROCEDURE IsLeapYear* (year: INTEGER): BOOLEAN; 20BEGIN RETURN (year MOD 4 = 0) & (~(year MOD 100 = 0) OR (year MOD 400 = 0)) 21END IsLeapYear; 22 23PROCEDURE LastDay (year, month: INTEGER): INTEGER; 24BEGIN 25 IF (month < 8) & ODD(month) OR (month > 7) & ~ODD(month) THEN RETURN 31 26 ELSIF month = 2 THEN 27 IF IsLeapYear(year) THEN RETURN 29 ELSE RETURN 28 END 28 ELSE RETURN 30 29 END 30END LastDay; 31 32(** Returns the number of days since 1.1.[firstY] *) 33PROCEDURE NumberOfDays* (date: LONGINT): LONGINT; 34VAR num: LONGINT; y, m: INTEGER; 35BEGIN 36 y := SHORT(date DIV 512) + zeroY - firstY; 37 m := SHORT(date DIV 32) MOD 16; 38 num := LONG(y) * 365 + y DIV 4 + A[(m - 1) MOD 12] + (date MOD 32) - 1; 39 IF IsLeapYear(firstY + y) & (m > 2) THEN INC(num) END; 40 RETURN num 41END NumberOfDays; 42 43(** Returns the date 1.1.[firstY] + days *) 44PROCEDURE NumberOfDaysToDate* (days: LONGINT): LONGINT; 45VAR M, m, y, d: LONGINT; 46BEGIN 47 IF (days + 307) MOD 1461 = 0 THEN d := 2 ELSE d := 1 END; 48 days := days - (days + 307) DIV 1461; y := firstY + days DIV 365; 49 IF firstY > y THEN y := zeroY; m := 1; d := 1 50 ELSE M := days MOD 365; m := T[M]; d := M - A[m - 1] + d 51 END; 52 RETURN ASH(ASH(y-zeroY, 4) + m, 5) + d 53END NumberOfDaysToDate; 54 55 56(** Converts year, month and day into an Oberon date *) 57PROCEDURE ToDate* (year, month, day: INTEGER): LONGINT; 58VAR d: INTEGER; 59BEGIN 60 month := 1 + (month - 1) MOD 12; 61 d := LastDay(year, month); day := 1 + (day - 1) MOD d; 62 RETURN ASH(ASH(year-zeroY, 4) + month, 5) + day 63END ToDate; 64 65(** Converts hour, min and sec into an Oberon time *) 66PROCEDURE ToTime* (hour, min, sec: INTEGER): LONGINT; 67BEGIN RETURN ((LONG(hour) MOD 24)*64 + (min MOD 60))*64 + (sec MOD 60) 68END ToTime; 69 70 71(** Extracts year, month and day of an Oberon date *) 72PROCEDURE ToYMD* (date: LONGINT; VAR year, month, day: INTEGER); 73BEGIN 74 year := SHORT(date DIV 512) + zeroY; 75 month := SHORT((date DIV 32) MOD 16); day := SHORT(date MOD 32) 76END ToYMD; 77 78(** Extracts hour, min and sec of an Oberon time *) 79PROCEDURE ToHMS* (time: LONGINT; VAR hour, min, sec: INTEGER); 80BEGIN 81 hour := SHORT(time DIV 4096); min := SHORT((time DIV 64) MOD 64); sec := SHORT(time MOD 64) 82END ToHMS; 83 84(** Returns weekday from date, where 0 is monday *) 85PROCEDURE DayOfWeek* (date: LONGINT): INTEGER; 86VAR num: LONGINT; 87BEGIN 88 num := NumberOfDays(date); 89 RETURN SHORT((num+1) MOD 7) 90END DayOfWeek; 91 92(** Returns number of days in a month *) 93PROCEDURE DaysOfMonth* (date: LONGINT): INTEGER; (* returns last day in month *) 94VAR year, month: LONGINT; 95BEGIN 96 month := (date DIV 32) MOD 16; year := (date DIV 512) + zeroY; 97 RETURN LastDay(SHORT(year), SHORT(month)) 98END DaysOfMonth; 99 100 101(** Following three procedures are used to add/subtract a certain amount of days/month/years. *) 102PROCEDURE AddYear* (date: LONGINT; years: INTEGER): LONGINT; 103VAR y, m, d: INTEGER; 104BEGIN 105 ToYMD(date, y, m, d); 106 IF firstY <= y + years THEN 107 IF IsLeapYear(y) & (m = 2) & (d = 29) & ~IsLeapYear(y + years) THEN d := 28 END; 108 date := ToDate(y + years, m, d) 109 END; 110 RETURN date 111END AddYear; 112 113PROCEDURE AddMonth* (date: LONGINT; months: INTEGER): LONGINT; 114VAR y, m, d: INTEGER; 115BEGIN 116 ToYMD(date, y, m, d); INC(m, months - 1); 117 y := y + m DIV 12; 118 IF firstY <= y THEN 119 m := m MOD 12 + 1; 120 IF m =2 THEN 121 IF (d > 29) & IsLeapYear(y) THEN d := 29 122 ELSIF (d > 28) & ~ IsLeapYear(y) THEN d := 28 123 END 124 ELSIF (d > 30) & ((m < 8) & ~ODD(m) OR (m > 7) & ODD(m)) THEN d := 30 125 END; 126 date := ToDate(y, m, d) 127 END; 128 RETURN date 129END AddMonth; 130 131PROCEDURE AddDay* (date: LONGINT; days: INTEGER): LONGINT; 132VAR num: LONGINT; 133BEGIN num := NumberOfDays(date); num := num + days; RETURN NumberOfDaysToDate(num) 134END AddDay; 135 136 137(** Following three procedures are used to add/subtract a certain amount of time. *) 138PROCEDURE AddHour* (time: LONGINT; hour: INTEGER): LONGINT; 139VAR s, m, h: INTEGER; 140BEGIN ToHMS(time, h, m, s); RETURN ToTime((h + hour) MOD 24, m, s) 141END AddHour; 142 143PROCEDURE AddMinute* (time: LONGINT; min: INTEGER): LONGINT; 144VAR s, m, h: INTEGER; 145BEGIN 146 ToHMS(time, h, m, s); INC(m, min); 147 IF (m < 0) OR (m >= 60) THEN h := (h + m DIV 60) MOD 24; m := m MOD 60 END; 148 RETURN ToTime(h, m, s) 149END AddMinute; 150 151PROCEDURE AddSecond* (time: LONGINT; sec: INTEGER): LONGINT; 152VAR s, m, h: INTEGER; 153BEGIN 154 ToHMS(time, h, m, s); INC(s, sec); 155 IF (s < 0) OR (s >= 60) THEN 156 INC(m, s DIV 60); s := s MOD 60; 157 IF (m < 0) OR (m >= 60) THEN h := (h + m DIV 60) MOD 24; m := m MOD 60 END 158 END; 159 RETURN ToTime(h, m, s) 160END AddSecond; 161 162(** Following procedure adds/subtracts a certain amount seconds to time/date. *) 163PROCEDURE AddTime* (VAR time, date: LONGINT; sec: LONGINT); 164VAR h, m, s: LONGINT; ss, mm, hh: INTEGER; 165BEGIN 166 ToHMS(time, hh, mm, ss); s := sec + ss; h := hh; m := mm; 167 IF (s < 0) OR (s >= 60) THEN 168 m := s DIV 60 + mm; s := s MOD 60; 169 IF (m < 0) OR (m >= 60) THEN 170 h := m DIV 60 + hh; m := m MOD 60; 171 IF (h < 0) OR (h >= 24) THEN 172 date := AddDay(date, SHORT(h DIV 24)); h := h MOD 24 173 END 174 END 175 END; 176 time := ToTime(SHORT(h), SHORT(m), SHORT(s)) 177END AddTime; 178 179PROCEDURE Init(); 180 VAR 181 diff: ARRAY 8 OF CHAR; 182 S: Texts.Scanner; 183 Txt : Texts.Text; (* noch *) 184 i, j: LONGINT; 185BEGIN 186 A[0] := 0; A[1] := 31; A[2] := 59; A[3] := 90; A[4] := 120; A[5] := 151; A[6] := 181; 187 A[7] := 212; A[8] := 243; A[9] := 273; A[10] := 304; A[11] := 334; A[12] := 365; 188 i := 0; j := 0; 189 WHILE i < 12 DO WHILE j < A[i+1] DO T[j] := SHORT(SHORT(i + 1)); INC(j) END; INC(i) END; 190 (*Oberon.OpenScanner(S, "System.TimeDiff");*) 191 NEW(Txt); 192 Texts.Open(Txt, "System.TimeDiff"); 193 Texts.OpenScanner(S, Txt, 0); 194 TimeDiff := 0; 195 IF S.class = Texts.String THEN 196 COPY(S.s, diff); 197 i := 0; j := 1; 198 IF diff[i] = "+" THEN 199 INC(i) 200 ELSIF diff[i] = "-" THEN 201 INC(i); j := -1 202 END; 203 WHILE (diff[i] >= "0") & (diff[i] <= "9") DO 204 TimeDiff := 10*TimeDiff+ORD(diff[i])-ORD("0"); 205 INC(i) 206 END; 207 TimeDiff := (TimeDiff DIV 100)*60 + (TimeDiff MOD 100); 208 TimeDiff := j*TimeDiff 209 END 210END Init; 211 212BEGIN 213 Init() 214END ethDates. 215