new/System/Mod/Dates.txt

   1 MODULE Dates;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Dates.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT Kernel;
   7
   8         CONST
   9                 monday* = 0;
  10                 tuesday* = 1;
  11                 wednesday* = 2;
  12                 thursday* = 3;
  13                 friday* = 4;
  14                 saturday* = 5;
  15                 sunday* = 6;
  16
  17                 short* = 0;
  18                 long* = 1;
  19                 abbreviated* = 2;
  20                 plainLong* = 3;
  21                 plainAbbreviated* = 4;
  22
  23         TYPE
  24                 Date* = RECORD
  25                         year*, month*, day*: INTEGER
  26                 END;
  27
  28                 Time* = RECORD
  29                         hour*, minute*, second*: INTEGER
  30                 END;
  31
  32                 Hook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
  33
  34         VAR M, N: ARRAY 8 OF INTEGER; hook: Hook;
  35
  36         PROCEDURE (h: Hook) GetTime* (OUT d: Date; OUT t: Time), NEW, ABSTRACT;
  37         PROCEDURE (h: Hook) GetUTCTime* (OUT d: Date; OUT t: Time), NEW, ABSTRACT;
  38         PROCEDURE (h: Hook) GetUTCBias* (OUT bias: INTEGER), NEW, ABSTRACT;
  39         PROCEDURE (h: Hook) DateToString* (d: Date; format: INTEGER; OUT str: ARRAY OF CHAR), NEW, ABSTRACT;
  40         PROCEDURE (h: Hook) TimeToString* (t: Time; OUT str: ARRAY OF CHAR), NEW, ABSTRACT;
  41
  42         PROCEDURE SetHook* (h: Hook);
  43         BEGIN
  44                 hook := h
  45         END SetHook;
  46
  47         PROCEDURE  ValidTime* (IN t: Time): BOOLEAN;
  48         BEGIN
  49                 RETURN
  50                         (t.hour >= 0) & (t.hour <= 23)
  51                         & (t.minute >= 0) & (t.minute <= 59)
  52                         & (t.second >= 0) & (t.second <= 59)
  53         END ValidTime;
  54
  55         PROCEDURE ValidDate* (IN d: Date): BOOLEAN;
  56                 VAR y, m, d1: INTEGER;
  57         BEGIN
  58                 IF (d.year < 1) OR (d.year > 9999) OR (d.month < 1) OR (d.month > 12) OR (d.day < 1) THEN
  59                         RETURN FALSE
  60                 ELSE
  61                         y := d.year; m := d.month;
  62                         IF m = 2 THEN
  63                                 IF (y < 1583) & (y MOD 4 = 0)
  64                                 OR (y MOD 4 = 0) & ((y MOD 100 # 0) OR (y MOD 400 = 0)) THEN
  65                                         d1 := 29
  66                                 ELSE d1 := 28
  67                                 END
  68                         ELSIF m IN {1, 3, 5, 7, 8, 10, 12} THEN d1 := 31
  69                         ELSE d1 := 30
  70                         END;
  71                         IF (y = 1582) & (m = 10) & (d.day > 4) & (d.day < 15) THEN RETURN FALSE END;
  72                         RETURN d.day <= d1
  73                 END
  74         END ValidDate;
  75
  76         PROCEDURE Day* (IN d: Date): INTEGER;
  77                 VAR y, m, n: INTEGER;
  78         BEGIN
  79                 y := d.year; m := d.month - 3;
  80                 IF m < 0 THEN INC(m, 12); DEC(y) END;
  81                 n := y * 1461 DIV 4 + (m * 153 + 2) DIV 5 + d.day - 306;
  82                 IF n > 577737 THEN n := n - (y DIV 100 * 3 - 5) DIV 4 END;
  83                 RETURN n
  84         END Day;
  85
  86         PROCEDURE DayToDate* (n: INTEGER; OUT d: Date);
  87                 VAR c, y, m: INTEGER;
  88         BEGIN
  89                 IF n > 577737 THEN
  90                         n := n * 4 + 1215; c := n DIV 146097; n := n MOD 146097 DIV 4
  91                 ELSE
  92                         n := n + 305; c := 0
  93                 END;
  94                 n := n * 4 + 3; y := n DIV 1461; n := n MOD 1461 DIV 4;
  95                 n := n * 5 + 2; m := n DIV 153; n := n MOD 153 DIV 5;
  96                 IF m > 9 THEN m := m - 12; INC(y) END;
  97                 d.year := SHORT(100 * c + y);
  98                 d.month := SHORT(m + 3);
  99                 d.day := SHORT(n + 1)
 100         END DayToDate;
 101
 102         PROCEDURE GetDate* (OUT d: Date);
 103                 VAR t: Time;
 104         BEGIN
 105                 ASSERT(hook # NIL, 100);
 106                 hook.GetTime(d, t)
 107         END GetDate;
 108
 109         PROCEDURE GetTime* (OUT t: Time);
 110                 VAR d: Date;
 111         BEGIN
 112                 ASSERT(hook # NIL, 100);
 113                 hook.GetTime(d, t)
 114         END GetTime;
 115
 116         (* UTC = Coordinated Universal Time, also konown as Greenwich Mean time (GMT). *)
 117
 118         PROCEDURE GetUTCDate* (OUT d: Date);
 119                 VAR t: Time;
 120         BEGIN
 121                 ASSERT(hook # NIL, 100);
 122                 hook.GetUTCTime(d, t)
 123         END GetUTCDate;
 124
 125         PROCEDURE GetUTCTime* (OUT t: Time);
 126                 VAR d: Date;
 127         BEGIN
 128                 ASSERT(hook # NIL, 100);
 129                 hook.GetUTCTime(d, t)
 130         END GetUTCTime;
 131
 132         PROCEDURE GetUTCBias* (OUT bias: INTEGER);
 133         (*
 134                 Returns the current bias, in minutes, for local time translation on this computer. The bias is the difference,
 135                 in minutes, between Coordinated Universal Time (UTC) and local time. All translations between UTC and
 136                 local time are based on the following formula:
 137                         UTC = local time + bias
 138         *)
 139         BEGIN
 140                 ASSERT(hook # NIL, 100);
 141                 hook.GetUTCBias(bias)
 142         END GetUTCBias;
 143
 144
 145         PROCEDURE GetEasterDate* (year: INTEGER; OUT d: Date);
 146                 VAR  k, m, n, a, b, c, d0, e, o: INTEGER; month, day: INTEGER;
 147         BEGIN
 148                 ASSERT((year >= 1583) & (year <= 2299), 20);
 149                 k := year DIV 100 - 15;
 150                 m := M[k]; n := N[k];
 151                 a := year MOD 19; b := year MOD 4; c := year MOD 7;
 152                 d0 := (19*a + m) MOD 30; e := (2*b+4*c+6*d0+n) MOD 7;
 153                 o := 21+d0+e; month := 3+o DIV 31; day := o MOD 31+1;
 154                 IF month = 4 THEN
 155                         IF day = 26 THEN day := 19
 156                         ELSIF (day = 25) & (d0=28) & (e = 6) & (a > 10) THEN day := 18
 157                         END
 158                 END;
 159                 d.year := year;
 160                 d.month := month;
 161                 d.day := day
 162         END GetEasterDate;
 163
 164         PROCEDURE  DayOfWeek* (IN d: Date): INTEGER;
 165         (** post: res = 0: Monday .. res = 6: Sunday **)
 166         BEGIN
 167                 RETURN SHORT((4+Day(d)) MOD 7)
 168         END DayOfWeek;
 169
 170         PROCEDURE DateToString* (IN d: Date; format: INTEGER; OUT str: ARRAY OF CHAR);
 171         BEGIN
 172                 ASSERT(hook # NIL, 100);
 173                 hook.DateToString(d, format, str)
 174         END DateToString;
 175
 176         PROCEDURE TimeToString* (IN t: Time; OUT str: ARRAY OF CHAR);
 177         BEGIN
 178                 ASSERT(hook # NIL, 100);
 179                 hook.TimeToString(t, str)
 180         END TimeToString;
 181
 182 BEGIN
 183         M[0] := 22; N[0] := 2;
 184         M[1] := 22; N[1] := 2;
 185         M[2] := 23; N[2] := 3;
 186         M[3] := 23; N[3] := 4;
 187         M[4] := 24; N[4] := 5;
 188         M[5] := 24; N[5] := 5;
 189         M[6] := 24; N[6] := 6;
 190         M[7] := 25; N[7] := 0;
 191 END Dates.