home *** CD-ROM | disk | FTP | other *** search
/ Aminet 18 / aminetcdnumber181997.iso / Aminet / dev / m2 / CycloneModules.lha / modules / txt / DateConversions.mod < prev    next >
Text File  |  1996-12-14  |  5KB  |  260 lines
  1. IMPLEMENTATION MODULE DateConversions;
  2.  
  3. (* (C) Copyright 1995, Marcel Timmermans. All rights reserved. *)
  4.  
  5. (*$ RangeChk- *)
  6.  
  7. FROM SYSTEM IMPORT ADR,ASSEMBLE,SETREG;
  8.  
  9. IMPORT DosD,io:InOut;
  10.  
  11. CONST
  12.   minYear=1978;
  13.   start=59;
  14.  
  15. TYPE
  16.   MonthsType=POINTER TO ARRAY[1..12] OF SHORTINT;
  17.  
  18. PROCEDURE MonthConst;
  19. (*$ EntryExitCode- *)
  20. (* MonthTabel *)
  21. BEGIN
  22.  ASSEMBLE( 
  23.   DC.B 31 
  24.   DC.B 28
  25.   DC.B 31
  26.   DC.B 30
  27.   DC.B 31
  28.   DC.B 30
  29.   DC.B 31
  30.   DC.B 31
  31.   DC.B 30
  32.   DC.B 31
  33.   DC.B 30
  34.   DC.B 31
  35.  END);
  36. END MonthConst;
  37.  
  38.  
  39. PROCEDURE DaysToDMY(Days:LONGINT; VAR d,m,y:LONGINT);
  40. VAR 
  41.   leap:LONGINT;
  42.   Months:MonthsType;
  43.   i:INTEGER;
  44.  
  45.  
  46.  PROCEDURE CalcDate;
  47.  BEGIN
  48.   y:=minYear; m:=0; leap:=0;
  49.   IF (Days<0) THEN 
  50.     DEC(y);
  51.     WHILE (Days + (365 + leap) < 0) DO
  52.       INC(Days,(365 + leap));
  53.       DEC(y);
  54.       IF ((y MOD 4 ) = 0) THEN leap:=1; END;
  55.       IF ((y MOD 4 ) = 1) THEN leap:=0; END;
  56.     END;
  57.   ELSE
  58.     INC(Days);
  59.     WHILE (Days - (365 + leap) > 0) DO
  60.       DEC(Days,(365+leap));
  61.       INC(y);
  62.       IF ((y MOD 4 ) = 0) THEN leap:=1; END;
  63.       IF ((y MOD 4 ) = 1) THEN leap:=0; END;
  64.     END;
  65.   END;
  66.  
  67.   INC(Months^[2],leap); (* leap year *)
  68.  
  69.   IF (Days<0) THEN
  70.     m:=12;
  71.     WHILE (ABS(Days)>Months^[m]) DO
  72.      INC(Days,Months^[m]);
  73.      DEC(m);
  74.     END;
  75.     INC(Days,(Months^[m]+1));
  76.   ELSE
  77.     m:=1;
  78.     WHILE (Days>Months^[m]) DO
  79.      DEC(Days,Months^[m]);
  80.      INC(m);
  81.     END;
  82.   END;
  83.   DEC(Months^[2],leap); (* leap year *)
  84.  END CalcDate;
  85.  
  86. BEGIN
  87.  Months:=ADR(MonthConst);
  88.  CalcDate; 
  89.  d:=Days;
  90. END DaysToDMY;
  91.  
  92. PROCEDURE DMYToDays(d,m,y:LONGINT):LONGINT;
  93. VAR 
  94.   Months:MonthsType;
  95.   i:LONGINT;
  96. BEGIN
  97.  IF (m<3) THEN DEC(d); END;
  98.  IF (y<minYear) THEN RETURN -1; END;
  99.  Months:=ADR(MonthConst);
  100.  WHILE (m>1) DO 
  101.   DEC(m);
  102.   INC(d,Months^[m]);
  103.  END;
  104.  WHILE (minYear<y) DO
  105.   DEC(y);
  106.   FOR i:=1 TO 12 DO INC(d,Months^[i]); END;
  107.   IF ((y MOD 4 ) = 0) THEN INC(d); END;
  108.  END;
  109.  RETURN d;
  110. END DMYToDays;
  111.  
  112.  
  113. PROCEDURE DateToStr(dt:DosD.Date;formatStr:ARRAY OF CHAR;VAR to:ARRAY OF CHAR);
  114. (*$ CopyDyn- *)
  115. TYPE
  116.   CharPtr=POINTER TO CHAR;
  117. VAR
  118.   fcnt:INTEGER;
  119.   toP:CharPtr;
  120.   day,month,year:LONGINT;
  121.  
  122.  
  123.  PROCEDURE AddVal(val{6}:LONGINT;Allign{5}:SHORTINT);
  124.  VAR 
  125.   i{7}:INTEGER;
  126.   valstr:ARRAY[0..5] OF CHAR;
  127.  BEGIN
  128.   FOR i:=5 TO 0 BY -1 DO
  129.    valstr[i]:=CHAR(INTEGER('0')+val MOD 10); 
  130.    val:=val DIV 10;
  131.   END;
  132.   WHILE Allign>0 DO toP^:=valstr[6-Allign]; INC(toP); DEC(Allign); END;
  133.   DEC(toP);
  134.  END AddVal;
  135.  
  136.  
  137. BEGIN
  138.  DaysToDMY(dt.days,day,month,year);
  139.  toP:=ADR(to);
  140.  fcnt:=0;
  141.  LOOP
  142.   IF formatStr[fcnt]='%' THEN
  143.     INC(fcnt);
  144.     CASE formatStr[fcnt] OF
  145.      | 'd': AddVal(day,2);
  146.      | 'm': AddVal(month,2);
  147.      | 'y': AddVal(year MOD 100,2);
  148.      | 'Y': AddVal(year,4);
  149.      | 'S': AddVal(dt.tick DIV 50,2);
  150.      | 'M': AddVal(dt.minute MOD 60,2);
  151.      | 'H': AddVal(dt.minute DIV 60,2);
  152.     ELSE
  153.      toP^:=formatStr[fcnt];
  154.     END;
  155.   ELSIF (formatStr[fcnt]=0C) OR (fcnt>=HIGH(formatStr)) THEN 
  156.     toP^:=0C;
  157.     EXIT;
  158.   ELSE
  159.    toP^:=formatStr[fcnt];
  160.   END;
  161.   INC(fcnt); INC(toP);
  162.  END;
  163. END DateToStr;
  164.  
  165.  
  166. PROCEDURE DayOfWeek(d,m,y:INTEGER):SHORTINT;
  167. VAR ma,jh,je,dd:LONGINT;
  168. BEGIN
  169.  ma:=m-2;
  170.  jh:=y DIV 100; je:= y MOD 100;
  171.  IF ma<=0 THEN
  172.   INC(ma,12);
  173.   DEC(je);
  174.  END;
  175.  IF je<0 THEN
  176.   je:=99;
  177.   DEC(jh);
  178.  END;
  179.  dd:=d+TRUNC(2.6*REAL(ma)-0.2)+(je / 4 + je)+(TRUNC(REAL(jh) / 4.0)-2*jh);
  180.  WHILE dd<0 DO INC(dd,7); END;
  181.  dd:=dd MOD 7;
  182.  RETURN dd;
  183. END DayOfWeek;
  184.  
  185. PROCEDURE dayOfWeek(dt:DosD.Date):SHORTINT;
  186. BEGIN
  187.  RETURN dt.days MOD 7;
  188. END dayOfWeek;
  189.  
  190. PROCEDURE Easter(year:LONGINT; VAR day,month:LONGINT);
  191. VAR a,b,c,d,e,M,N:LONGINT;
  192. BEGIN
  193.  IF year<100 THEN INC(year,1900); END;
  194.  a:=year MOD 19;
  195.  b:=year MOD 4;
  196.  c:=year MOD 7;
  197.  IF year<=1582 THEN 
  198.   M:=15; N:=6;
  199.  ELSE
  200.   M:=((year DIV 100) - (year DIV 400) - (year DIV 300) + 15) MOD 30; 
  201.   N:=((year DIV 100) - (year DIV 400) + 4) MOD 7;
  202.  END;
  203.  d:=(19*a+M) MOD 30;
  204.  e:=(2*b+4*c+6*d+N) MOD 7;
  205. (* io.WriteInt(a,3); io.WriteLn;
  206.  io.WriteInt(b,3); io.WriteLn;
  207.  io.WriteInt(c,3); io.WriteLn;
  208.  io.WriteInt(d,3); io.WriteLn;
  209.  io.WriteInt(e,3); io.WriteLn;
  210.  io.WriteInt(M,3); io.WriteLn;
  211.  io.WriteInt(N,3); io.WriteLn; *)
  212.  IF (e=6) AND ((d=29) OR ((d=28) AND (a>10))) THEN
  213.    day:=15+d+e;
  214.  ELSE
  215.    day:=22+d+e;
  216.  END;
  217.  IF day<32 THEN month:=3; ELSE month:=4; DEC(day,31); END;
  218. END Easter;
  219.  
  220.  
  221. PROCEDURE WhitSun(year:LONGINT; VAR day,month:LONGINT);
  222. VAR days:LONGINT;
  223. BEGIN
  224.  Easter(year,day,month);
  225.  DaysToDMY(DMYToDays(day,month,year)+49,day,month,year);
  226. END WhitSun;
  227.  
  228. PROCEDURE WhitMon(year:LONGINT; VAR day,month:LONGINT);
  229. VAR days:LONGINT;
  230. BEGIN
  231.  Easter(year,day,month);
  232.  DaysToDMY(DMYToDays(day,month,year)+50,day,month,year);
  233. END WhitMon;
  234.  
  235. PROCEDURE AscensionDay(year:LONGINT; VAR day,month:LONGINT);
  236. BEGIN
  237.  Easter(year,day,month);
  238.  DaysToDMY(DMYToDays(day,month,year)+39,day,month,year); 
  239. END AscensionDay;
  240.  
  241. PROCEDURE SacramentalDay(year:LONGINT; VAR day,month:LONGINT); 
  242. BEGIN
  243.  Easter(year,day,month);
  244.  DaysToDMY(DMYToDays(day,month,year)+60,day,month,year);
  245. END SacramentalDay;
  246.  
  247. PROCEDURE ChristMas1(day,month:LONGINT);
  248. BEGIN
  249.  day:=25;
  250.  month:=12;
  251. END ChristMas1;
  252.  
  253. PROCEDURE ChristMas2(day,month:LONGINT);
  254. BEGIN
  255.  day:=26;
  256.  month:=12;
  257. END ChristMas2;
  258.  
  259. END DateConversions.
  260.