class Dates; hidden protected M_leng, M_tab, L_year, WE_tab, WN_tab; begin text array WE_tab, WN_tab(0:6); integer array M_tab(1:12); integer Sunday = 0, Monday = 1, Tuesday = 2, Wednesday = 3, Thursday = 4, Friday = 5, Saturday = 6; class Date(D, M, Y); integer D, M, Y; hidden protected N_days, N_image; begin integer procedure N_days; begin integer Sum, Ix; Sum := (Y-1)*365 + (Y-1)//4 - (Y-1)//100 + (Y-1)//400; for Ix := M-1 step -1 until 1 do Sum := Sum + M_leng(Ix,Y); N_days := Sum + D; end N_days; text procedure N_image(Nx); integer Nx; begin text Tx; Tx :- Blanks(4); Tx.PutInt(Nx); Tx.SetPos(1); while Tx.GetChar = ' ' do ; N_image :- Tx.Sub(Tx.Pos-1,6-Tx.Pos); end N_image; ref(Date) procedure Plus(Nx); integer Nx; begin Plus :- new Date(D+Nx,M,Y); end Plus; ref(Date) procedure Suc; begin Suc :- Plus(1); end Suc; ref(Date) procedure Minus(Nx); integer Nx; begin Minus :- Plus(-Nx); end Minus; ref(Date) procedure Pred; begin Pred :- Minus(1); end Pred; integer procedure Diff(Dx); ref(Date) Dx; begin Diff := Dx.N_days - N_days; end Diff; integer procedure Weekday; begin Weekday := Mod(N_days,7); end Weekday; integer procedure Weeknum; begin ref(Date) Jan1; integer Jan1W, Jan1WN, Nx, Dx; Jan1 :- new Date(1,1,Y); Jan1W := Jan1.Weekday; Jan1WN := if Jan1W=Friday or Jan1W=Saturday or Jan1W=Sunday then 0 else 1; Nx := N_days; if Mod(Nx,7) <> 0 then Dx := 7 - Mod(Nx,7); Weeknum := Jan1WN + Jan1.Diff(Plus(Dx))//7; end Weeknum; text procedure Weekday_english; begin Weekday_english :- Copy(WE_tab(Weekday)); end Weekday_english; text procedure Weekday_norsk; begin Weekday_norsk :- Copy(WN_tab(Weekday)); end Weekday_norsk; integer procedure Days_in_month; begin Days_in_month := M_leng(M, Y); end Days_in_month; Boolean procedure Is_leapyear; begin Is_leapyear := L_year(Y); end Is_leapyear; Boolean procedure Is_weekend; begin integer Dx; Dx := Weekday; Is_weekend := Dx=Sunday or Dx=Saturday; end Is_weekend; Boolean procedure Is_same(Dx); ref(Date) Dx; begin Is_same := D=Dx.D and M=Dx.M and Y=Dx.Y; end Is_same; Boolean procedure Is_norwegian_holiday; begin ref(Date) Ex; Ex :- Easter(Y); Is_norwegian_holiday := Is_same(new Date(1,1,Y)) or Is_same(new Date(1,5,Y)) or Is_same(new Date(17,5,Y)) or Is_same(new Date(24,12,Y)) or Is_same(new Date(25,12,Y)) or Is_same(new Date(26,12,Y)) or Is_same(Ex.Minus(3)) or Is_same(Ex.Minus(2)) or Is_same(Ex) or Is_same(Ex.Plus(1)) or Is_same(Ex.Plus(39)) or Is_same(Ex.Plus(49)) or Is_same(Ex.Plus(50)); end Is_norwegian_holiday; text procedure Image; begin Image :- N_image(D) & "." & N_Image(M) & "." & N_image(Y); end Image; comment Normalize date: ; while M < 1 do begin M := M+12; Y := Y-1; end while; while M > 12 do begin M := M-12; Y := Y+1; end while; while D < 1 do begin M := M-1; if M = 0 then begin M := 12; Y := Y-1; end if; D := D+M_leng(M,Y); end while; while D > M_leng(M,Y) do begin D := D-M_leng(M,Y); M := M+1; if M = 13 then begin M := 1; Y := Y+1; end if; end while; end Date; integer procedure M_leng(Mx, Yx); integer Mx, Yx; begin if Mx = 2 then M_leng := if L_year(Yx) then 29 else 28 else M_leng := M_tab(Mx); end M_leng; Boolean procedure L_year(Yx); integer Yx; begin L_year := Mod(Yx,4)=0 and Mod(Yx,100)>0 or Mod(Yx,400)=0; end L_year; ref(Date) procedure Today; begin text Tx, Dx, Mx, Yx; Tx :- DateTime; Dx :- Tx.Sub(9,2); Mx :- Tx.Sub(6,2); Yx :- Tx.Sub(1,4); Today :- new Date(Dx.GetInt,Mx.GetInt,Yx.GetInt); end Today; ref(Date) procedure Easter(Y); integer Y; begin integer G, C, X, Z, D, E, N; G := Mod(Y,19) + 1; C := Y//100 + 1; X := (3*C)//4 - 12; Z := (8*C+5)//25 - 5; D := (5*Y)//4 - X - 10; E := Mod(11*G+20+Z-X,30); if E=25 and G>11 or E=24 then E := E+1; N := 44-E; if N < 21 then N := N+30; N := N+7-Mod(D+N,7); Easter :- new Date(N,3,Y); end Easter; comment Initialize tables: ; M_tab(1) := M_tab( 3) := M_tab( 5) := M_tab(7) := 31; M_tab(8) := M_tab(10) := M_tab(12) := 31; M_tab(4) := M_tab(6) := M_tab(9) := M_tab(11) := 30; M_tab(2) := 28; WE_tab(0) :- "Sunday"; WN_tab(0) :- "søndag"; WE_tab(1) :- "Monday"; WN_tab(1) :- "mandag"; WE_tab(2) :- "Tuesday"; WN_tab(2) :- "tirsdag"; WE_tab(3) :- "Wednesday"; WN_tab(3) :- "onsdag"; WE_tab(4) :- "Thursday"; WN_tab(4) :- "torsdag"; WE_tab(5) :- "Friday"; WN_tab(5) :- "fredag"; WE_tab(6) :- "Saturday"; WN_tab(6) :- "lørdag"; end Dates;