MODULE Dates;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT Kernel;
CONST
monday* = 0;
tuesday* = 1;
wednesday* = 2;
thursday* = 3;
friday* = 4;
saturday* = 5;
sunday* = 6;
short* = 0;
long* = 1;
abbreviated* = 2;
plainLong* = 3;
plainAbbreviated* = 4;
TYPE
Date* = RECORD
year*, month*, day*: INTEGER
END;
Time* = RECORD
hour*, minute*, second*: INTEGER
END;
Hook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
VAR M, N: ARRAY 8 OF INTEGER; hook: Hook;
PROCEDURE (h: Hook) GetTime* (OUT d: Date; OUT t: Time), NEW, ABSTRACT;
PROCEDURE (h: Hook) GetUTCTime* (OUT d: Date; OUT t: Time), NEW, ABSTRACT;
PROCEDURE (h: Hook) GetUTCBias* (OUT bias: INTEGER), NEW, ABSTRACT;
PROCEDURE (h: Hook) DateToString* (d: Date; format: INTEGER; OUT str: ARRAY OF CHAR), NEW, ABSTRACT;
PROCEDURE (h: Hook) TimeToString* (t: Time; OUT str: ARRAY OF CHAR), NEW, ABSTRACT;
PROCEDURE SetHook* (h: Hook);
BEGIN
hook := h
END SetHook;
PROCEDURE
ValidTime* (IN t: Time): BOOLEAN;
BEGIN
RETURN
(t.hour >= 0) & (t.hour <= 23)
& (t.minute >= 0) & (t.minute <= 59)
& (t.second >= 0) & (t.second <= 59)
END ValidTime;
PROCEDURE ValidDate* (IN d: Date): BOOLEAN;
VAR y, m, d1: INTEGER;
BEGIN
IF (d.year < 1) OR (d.year > 9999) OR (d.month < 1) OR (d.month > 12) OR (d.day < 1) THEN
RETURN FALSE
ELSE
y := d.year; m := d.month;
IF m = 2 THEN
IF (y < 1583) & (y MOD 4 = 0)
OR (y MOD 4 = 0) & ((y MOD 100 # 0) OR (y MOD 400 = 0)) THEN
d1 := 29
ELSE d1 := 28
END
ELSIF m IN {1, 3, 5, 7, 8, 10, 12} THEN d1 := 31
ELSE d1 := 30
END;
IF (y = 1582) & (m = 10) & (d.day > 4) & (d.day < 15) THEN RETURN FALSE END;
RETURN d.day <= d1
END
END ValidDate;
PROCEDURE Day* (IN d: Date): INTEGER;
VAR y, m, n: INTEGER;
BEGIN
y := d.year; m := d.month - 3;
IF m < 0 THEN INC(m, 12); DEC(y) END;
n := y * 1461 DIV 4 + (m * 153 + 2) DIV 5 + d.day - 306;
IF n > 577737 THEN n := n - (y DIV 100 * 3 - 5) DIV 4 END;
RETURN n
END Day;
PROCEDURE DayToDate* (n: INTEGER; OUT d: Date);
VAR c, y, m: INTEGER;
BEGIN
IF n > 577737 THEN
n := n * 4 + 1215; c := n DIV 146097; n := n MOD 146097 DIV 4
ELSE
n := n + 305; c := 0
END;
n := n * 4 + 3; y := n DIV 1461; n := n MOD 1461 DIV 4;
n := n * 5 + 2; m := n DIV 153; n := n MOD 153 DIV 5;
IF m > 9 THEN m := m - 12; INC(y) END;
d.year := SHORT(100 * c + y);
d.month := SHORT(m + 3);
d.day := SHORT(n + 1)
END DayToDate;
PROCEDURE GetDate* (OUT d: Date);
VAR t: Time;
BEGIN
ASSERT(hook # NIL, 100);
hook.GetTime(d, t)
END GetDate;
PROCEDURE GetTime* (OUT t: Time);
VAR d: Date;
BEGIN
ASSERT(hook # NIL, 100);
hook.GetTime(d, t)
END GetTime;
(* UTC = Coordinated Universal Time, also konown as Greenwich Mean time (GMT). *)
PROCEDURE GetUTCDate* (OUT d: Date);
VAR t: Time;
BEGIN
ASSERT(hook # NIL, 100);
hook.GetUTCTime(d, t)
END GetUTCDate;
PROCEDURE GetUTCTime* (OUT t: Time);
VAR d: Date;
BEGIN
ASSERT(hook # NIL, 100);
hook.GetUTCTime(d, t)
END GetUTCTime;
PROCEDURE GetUTCBias* (OUT bias: INTEGER);
(*
Returns the current bias, in minutes, for local time translation on this computer. The bias is the difference,
in minutes, between Coordinated Universal Time (UTC) and local time. All translations between UTC and
local time are based on the following formula:
UTC = local time + bias
*)
BEGIN
ASSERT(hook # NIL, 100);
hook.GetUTCBias(bias)
END GetUTCBias;
PROCEDURE GetEasterDate* (year: INTEGER; OUT d: Date);
VARk, m, n, a, b, c, d0, e, o: INTEGER; month, day: INTEGER;
BEGIN
ASSERT((year >= 1583) & (year <= 2299), 20);
k := year DIV 100 - 15;
m := M[k]; n := N[k];
a := year MOD 19; b := year MOD 4; c := year MOD 7;
d0 := (19*a + m) MOD 30; e := (2*b+4*c+6*d0+n) MOD 7;
o := 21+d0+e; month := 3+o DIV 31; day := o MOD 31+1;
IF month = 4 THEN
IF day = 26 THEN day := 19
ELSIF (day = 25) & (d0=28) & (e = 6) & (a > 10) THEN day := 18
END
END;
d.year := year;
d.month := month;
d.day := day
END GetEasterDate;
PROCEDURE
DayOfWeek* (IN d: Date): INTEGER;
(** post: res = 0: Monday .. res = 6: Sunday **)
BEGIN
RETURN SHORT((4+Day(d)) MOD 7)
END DayOfWeek;
PROCEDURE DateToString* (IN d: Date; format: INTEGER; OUT str: ARRAY OF CHAR);
BEGIN
ASSERT(hook # NIL, 100);
hook.DateToString(d, format, str)
END DateToString;
PROCEDURE TimeToString* (IN t: Time; OUT str: ARRAY OF CHAR);
BEGIN
ASSERT(hook # NIL, 100);
hook.TimeToString(t, str)
END TimeToString;
BEGIN
M[0] := 22; N[0] := 2;
M[1] := 22; N[1] := 2;
M[2] := 23; N[2] := 3;
M[3] := 23; N[3] := 4;
M[4] := 24; N[4] := 5;
M[5] := 24; N[5] := 5;
M[6] := 24; N[6] := 6;
M[7] := 25; N[7] := 0;
END Dates.