calendars routines

[ggauny@live.fr]

[attachment=1449][attachment=1449]Hi, a little routine or subroutine helpfull to construct calendar of any year
range 01/01/-4712 to 12/31/9999. Helpfull too for translate in others cal-
endars.

Code:


EXPORT FIRSTDAYOFYEAR(YEAR)
BEGIN
LOCAL DATE,D,NJD;
DATE:=1+.01+YEAR/1000000;

DOWMOI(DATE)▶D;
D2JD(DATE)▶NJD;

RETURN(D+" "+NJD);

END;

EXPORT D2JD(DATE)
BEGIN
LOCAL A,B,AN,JD;
J:=IP(DATE);
M:=IP(FP(DATE)*100);
AN:=IP(FP(FP(DATE)*100)*10000);

IF M<3 THEN AN:=AN-1;M:=M+12
END;
A:=IP(AN/100);B:=2-A+IP(A/4);
IF AN+M/100+J/10000 < 1582.1014
 THEN 0▶B END;
JD:=IP(365.25*(AN+4716))+IP(30.6001*(M+1))
    +J+B-1524.5;
RETURN(JD);
END;

EXPORT DOWMOI(DATE)
BEGIN
LOCAL A,B:=2,AN,M,J,JD,CR;
LOCAL JUL;
{"Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi"}▶L1;
IP(DATE)▶J;
IP(FP(DATE)*100)▶M;
IP(FP(FP(DATE)*100)*10000)▶AN;
//LEAP YEAR ?
CASE
IF (NOT(AN MOD 4) AND AN MOD 100)
 OR(NOT(AN MOD 400))
  THEN B:=1; // LEAP
  END;

IF AN<1582 AND irem(AN,4)==0
   THEN B:=1; //LEAP
   END;
END;
IF M<3 THEN AN:=AN-1;M:=M+12
END;
IF(AN+M/100+J/10000)<1582.10145
  THEN 1▶JUL;
  
END;
A:=IP(AN/100);CR:=2-A+IP(A/4);
IF JUL==1 THEN 0▶CR END;
JD:=IP(365.25*(AN+4716))+IP(30.6001*(M+1))
    +J+CR-1524.5;
JD:=JD+1.5;
JD:=irem(JD,7)▶N;
(L1(N+1));
END;

For example, typing 1928 in FIRSTDAYOFYEAR give :
"Dimanche 2425246.5"
Dimanche is Sunday, and the JDNumber is the traditional AT NOON.

typing 333 wil give :
"Lundi 1842686.5"
Lundi is Monday.

Regards Gérard.