IMPLEMENTATION MODULE Datum; (* Copyright 1993 by Kai Hofmann *)

 (*$ StackChk    := FALSE *)
 (*$ RangeChk    := FALSE *)
 (*$ OverflowChk := FALSE *)
 (*$ NilChk      := FALSE *)
 (*$ CaseChk     := FALSE *)
 (*$ ReturnChk   := FALSE *)
 (*$ LargeVars   := FALSE *)
 (*$ EntryClear  := TRUE  *)
 (*$ Volatile    := TRUE  *)
 (*$ StackParms  := TRUE  *)
 (*$ CStrings    := TRUE  *)


 FROM SYSTEM		IMPORT	ADR,ADDRESS;
 FROM IntuitionL	IMPORT	CurrentTime;
 FROM Conversions	IMPORT	ValToStr;
 FROM String		IMPORT	Concat,Length,Copy;
 FROM UtilityD		IMPORT	ClockData;
 FROM UtilityL		IMPORT	Amiga2Date,Date2Amiga(*,CheckDate*);
 FROM LocaleD		IMPORT	day1,day2,day3,day4,day5,day6,day7,
				mon1,mon2,mon3,mon4,mon5,mon6,mon7,mon8,mon9,
				mon10,mon11,mon12,
				LocalePtr,Locale;
 FROM LocaleL		IMPORT	localeBase,GetLocaleStr,OpenLocale,CloseLocale;


 TYPE
	str	= POINTER TO ARRAY [0..20] OF CHAR;


 CONST
	ErsterTag	=    1; (* Ab diesem Datum fängt die Systemzeit *)
 	ErsterMonat	=    1; (* an zu zählen.                        *)
 	ErstesJahr	= 1978;
 	ErsterWochentag =    7;


 VAR
	wlen,mlen	: SHORTCARD;
	lstr		: ADDRESS;
	lptr		: LocalePtr;


 PROCEDURE GetSeconds() : LONGCARD;	(* Holt die Systemzeit des Amiga *)
					(* in Sekunden			 *)
 VAR
	sekunden,microsek : LONGCARD;

 BEGIN
   CurrentTime(ADR(sekunden),ADR(microsek));
   RETURN sekunden;
 END GetSeconds;


 PROCEDURE Schaltjahr(Jahr : CARDINAL) : BOOLEAN; (* Ermittelt, ob es sich *)
						  (* bei Jahr um ein       *)
 BEGIN						  (* Schaltjahr handelt    *)
   IF (Jahr MOD 4 = 0) AND ((Jahr MOD 100 > 0) OR ((Jahr MOD 400 = 0) AND (Jahr MOD 3200 > 0))) THEN
     RETURN(TRUE);
   ELSE
     RETURN(FALSE);
   END;
 END Schaltjahr;

(*
 PROCEDURE Year(VAR Tag : LONGCARD) : CARDINAL; (* Ermittelt das Jahr durch   *)
					        (* umrechnung der anzahl Tage *)
 VAR
	JAHR : CARDINAL;		       (* die seit dem Systemstart   *)
					       (* (siehe CONST) vergangen    *)
 BEGIN					       (* sind.			     *)
   INC(Tag);
   JAHR := ErstesJahr;
   REPEAT
     Tag := Tag - 365;
     IF Schaltjahr(JAHR) THEN
       DEC(Tag);
     END;
     INC(JAHR);
   UNTIL ((Tag <= 365) AND (NOT Schaltjahr(JAHR))) OR
					(Schaltjahr(JAHR) AND (Tag <= 366));
   RETURN(JAHR);
 END Year;
*)

 PROCEDURE maxDays(Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD; (* Ermittelt die Anzahl *)
						    (* von Tagen, welche es *)
 BEGIN						    (* in einem Monat gibt. *)
   IF Monat IN {1,3,5,7,8,10,12} THEN		    (* bei einem falschen   *)
     RETURN(31);				    (* Monat wird 0 als     *)
   ELSIF Monat IN {4,6,9,11} THEN		    (* Fehler ausgegeben    *)
     RETURN(30);
   ELSIF (Monat = 2) AND Schaltjahr(Jahr) THEN
     RETURN(29);
   ELSIF (Monat = 2) AND (NOT Schaltjahr(Jahr)) THEN
     RETURN(28);
   ELSE
     RETURN(0);
   END;
 END maxDays;

(*
 PROCEDURE Month(VAR Tag : LONGCARD; Jahr : CARDINAL) : SHORTCARD; (* Ermittelt *)
								(* den akt.  *)
 VAR								(* Monat.    *)
	MONAT : SHORTCARD;

 BEGIN
   MONAT := ErsterMonat;
   WHILE Tag > maxDays(MONAT,Jahr) DO
     Tag := Tag - maxDays(MONAT,Jahr);
     INC(MONAT);
   END;
   RETURN(MONAT);
 END Month;
*)

 PROCEDURE Weekday (Tag,Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD;(* Ermittelt aus dem *)
							(* Datum den Wochen- *)
 VAR							(* tag. (1 = Montag) *)
	JAHR		: CARDINAL;
	WOCHENTAG	: CARDINAL;
	MONAT		: SHORTCARD;

 BEGIN
   WOCHENTAG := ErsterWochentag;
   JAHR := ErstesJahr;
   WHILE JAHR < Jahr DO
     INC(JAHR);
     INC(WOCHENTAG);
     IF Schaltjahr(JAHR) AND (JAHR # Jahr) THEN
       INC(WOCHENTAG);
     END;
   END;
   MONAT := 1;
   WHILE MONAT < Monat DO
     WOCHENTAG := WOCHENTAG + maxDays(MONAT,Jahr);
     INC(MONAT);
   END;
   WOCHENTAG := WOCHENTAG + Tag - 1;
   WOCHENTAG := WOCHENTAG MOD 7;
   IF WOCHENTAG = 0 THEN
     WOCHENTAG := 7;
   END;
   RETURN(SHORTCARD(WOCHENTAG));
 END Weekday;


 PROCEDURE GetDate (VAR Wochentag,Tag,Monat : SHORTCARD; VAR Jahr : CARDINAL);(* Holt das      *)
							    (* aktuelle Datum*)
 VAR
	clock	: ClockData;
	(*sekunden		: LONGCARD;
	Sekunde,Minute,Stunde	: SHORTCARD;*)

 BEGIN
   Amiga2Date(GetSeconds(),clock);
   Tag := clock.mday;
   Monat := clock.month;
   Jahr := clock.year;
   Wochentag := clock.wday;
   IF Wochentag = 0 THEN
     Wochentag := 7;
   END;
 (*sekunden	:= GetSeconds();
   Sekunde	:= sekunden - (sekunden DIV 60) * 60;
   sekunden	:= (sekunden - Sekunde) DIV 60;
   Minute	:= sekunden - (sekunden DIV 60) * 60;
   sekunden	:= (sekunden - Minute) DIV 60;
   Stunde	:= sekunden - (sekunden DIV 24) * 24;
   sekunden	:= (sekunden - Stunde) DIV 24;
   Jahr		:= Year(sekunden);
   Monat	:= Month(sekunden,Jahr);
   Tag		:= sekunden;
   Wochentag	:= Weekday(Tag,Monat,Jahr);*)
 END GetDate;


 PROCEDURE GetTime (VAR Stunde,Minute,Sekunde : SHORTCARD);(* Holt die aktuelle*)
							 (* Uhrzeit.	     *)
 VAR
	clock	: ClockData;
	(*sekunden : LONGCARD;*)

 BEGIN
   Amiga2Date(GetSeconds(),clock);
   Stunde := clock.hour;
   Minute := clock.min;
   Sekunde := clock.sec;
 (*sekunden  := GetSeconds();
   Sekunde   := sekunden - (sekunden DIV 60) * 60;
   sekunden  := (sekunden - Sekunde) DIV 60;
   Minute    := sekunden - (sekunden DIV 60) * 60;
   sekunden  := (sekunden - Minute) DIV 60;
   Stunde    := sekunden - (sekunden DIV 24) * 24;*)
 END GetTime;


 PROCEDURE tagdiff(tag1,monat1 : SHORTCARD; jahr1 : CARDINAL; tag2,monat2 : SHORTCARD; jahr2 : CARDINAL) : LONGINT;
						(* Berechnet die       *)
 VAR						(* differnenz zwischen *)
	t1,t2 : LONGCARD;			(* zwei Daten in Tagen *)
						(* Datum1 > Datum2     *)
 BEGIN						(* ergibt negatives    *)
   t1 := tag1;					(* Ergebnis	       *)
   t2 := tag2;
   WHILE monat1 > 1 DO
     DEC(monat1);
     t1 := t1 + maxDays(monat1,jahr1);
   END;
   WHILE monat2 > 1 DO
     DEC(monat2);
     t2 := t2 + maxDays(monat2,jahr2);
   END;
   WHILE jahr1 > jahr2 DO
     t1 := t1 + 365;
     DEC(jahr1);
     IF Schaltjahr(jahr1) THEN
       INC(t1);
     END;
   END;
   WHILE jahr2 > jahr1 DO
     t2 := t2 + 365;
     DEC(jahr2);
     IF Schaltjahr(jahr2) THEN
       INC(t2);
     END;
   END;
   RETURN(t2-t1);
 END tagdiff;


 PROCEDURE wochentag(Tag : SHORTCARD; VAR string : wtstring;
				      Sprache : SHORTCARD) : SHORTCARD;
							    (* Gibt den      *)
 VAR							    (* Wochentag als *)
	len : SHORTCARD;				    (* Text zurück   *)

 BEGIN
   string := "";
   CASE Sprache OF
     0 : CASE Tag OF
           1 : Copy(string,str(GetLocaleStr(lptr,day2))^); |
           2 : Copy(string,str(GetLocaleStr(lptr,day3))^); |
           3 : Copy(string,str(GetLocaleStr(lptr,day4))^); |
           4 : Copy(string,str(GetLocaleStr(lptr,day5))^); |
           5 : Copy(string,str(GetLocaleStr(lptr,day6))^); |
           6 : Copy(string,str(GetLocaleStr(lptr,day7))^); |
           7 : Copy(string,str(GetLocaleStr(lptr,day1))^); |
         ELSE
         END;
         len := wlen;|
     1 : CASE Tag OF
	   1 : string := "monday";    |
	   2 : string := "tuesday";   |
	   3 : string := "wednesday"; |
	   4 : string := "thursday";  |
	   5 : string := "freiday";   |
	   6 : string := "saturday";  |
	   7 : string := "sunday";
	 ELSE
	 END;
         len := 9;|
     2 : CASE Tag OF
	   1 : string := "Montag";     |
	   2 : string := "Dienstag";   |
	   3 : string := "Mittwoch";   |
	   4 : string := "Donnerstag"; |
	   5 : string := "Freitag";    |
	   6 : string := "Samstag";    |
	   7 : string := "Sonntag";
	 ELSE
	 END;
         len := 10;|
     3 : CASE Tag OF
	   1 : string := "lundi";   |
	   2 : string := "mardi";   |
	   3 : string := "mercredi";|
	   4 : string := "jeudi";   |
	   5 : string := "vendredi";|
	   6 : string := "samedi";  |
	   7 : string := "dimanche";
	 ELSE
	 END;
         len := 8;|
     4 : CASE Tag OF
	   1 : string := "lunes";     |
	   2 : string := "martes";    |
	   3 : string := "miércoles";|
	   4 : string := "jueves";    |
	   5 : string := "viernes";   |
	   6 : string := "sábado";   |
	   7 : string := "domingo";
	 ELSE
	 END;
         len := 9;
   END;
   RETURN(len);
 END wochentag;


 PROCEDURE GetWeek(Tag,Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD;

 VAR week : SHORTCARD;
     wt   : SHORTCARD;

 BEGIN
    wt := Weekday(1,1,Jahr);
    IF wt = 1 THEN
      week := tagdiff(1,1,Jahr,Tag,Monat,Jahr) DIV 7 +1;
    ELSE
      week := tagdiff(9-wt,1,Jahr,Tag,Monat,Jahr);
      IF week < 0 THEN
        week := GetWeek(31,12,Jahr-1);
      ELSE
        week := week DIV 7 +1;
      END;
    END;
    RETURN(week);
 END GetWeek;


 PROCEDURE FormatDate(Tag,Monat : SHORTCARD; Jahr : CARDINAL; VAR datum : datestr);

 VAR tag,monat	: ARRAY [1..3] OF CHAR;
     jahr	: ARRAY [1..5] OF CHAR;
     err	: BOOLEAN;

 BEGIN
   IF datum[0] = 'l' THEN
     (* use locale.library *)
   ELSE
     datum := "";
     ValToStr(Tag,FALSE,tag,10,2,'0',err);
     ValToStr(Monat,FALSE,monat,10,2,'0',err);
     ValToStr(Jahr,FALSE,jahr,10,4,'0',err);
     Concat(datum,tag);
     Concat(datum,".");
     Concat(datum,monat);
     Concat(datum,".");
     Concat(datum,jahr);
   END;
 END FormatDate;


 PROCEDURE monat(Monat : SHORTCARD; VAR string : wtstring;
					Sprache : SHORTCARD) : SHORTCARD;

 VAR
	len : SHORTCARD;

 BEGIN
   string := "";
   CASE Sprache OF
     0 : CASE Monat OF
            1 : Copy(string,str(GetLocaleStr(lptr,mon1))^); |
            2 : Copy(string,str(GetLocaleStr(lptr,mon2))^); |
            3 : Copy(string,str(GetLocaleStr(lptr,mon3))^); |
            4 : Copy(string,str(GetLocaleStr(lptr,mon4))^); |
            5 : Copy(string,str(GetLocaleStr(lptr,mon5))^); |
            6 : Copy(string,str(GetLocaleStr(lptr,mon6))^); |
            7 : Copy(string,str(GetLocaleStr(lptr,mon7))^); |
            8 : Copy(string,str(GetLocaleStr(lptr,mon8))^); |
            9 : Copy(string,str(GetLocaleStr(lptr,mon9))^); |
           10 : Copy(string,str(GetLocaleStr(lptr,mon10))^);|
           11 : Copy(string,str(GetLocaleStr(lptr,mon11))^);|
           12 : Copy(string,str(GetLocaleStr(lptr,mon12))^);|
         ELSE
         END;
         len := mlen;|
     1 : CASE Monat OF
	    1 : string := "january";|
	    2 : string := "february";|
	    3 : string := "march";|
	    4 : string := "april";|
	    5 : string := "may";|
	    6 : string := "june";|
	    7 : string := "july";|
	    8 : string := "august";|
	    9 : string := "september";|
	   10 : string := "october";|
	   11 : string := "november";|
	   12 : string := "december";
	 ELSE
	 END;
         len := 9;|
     2 : CASE Monat OF
	    1 : string := "Januar";|
	    2 : string := "Februar";|
	    3 : string := "März";|
	    4 : string := "April";|
	    5 : string := "Mai";|
	    6 : string := "Juni";|
	    7 : string := "Juli";|
	    8 : string := "August";|
	    9 : string := "September";|
	   10 : string := "Oktober";|
	   11 : string := "November";|
	   12 : string := "Dezember";
	 ELSE
	 END;
         len := 9;|
     3 : CASE Monat OF
	    1 : string := "janvier";|
	    2 : string := "février";|
	    3 : string := "mars";|
	    4 : string := "avril";|
	    5 : string := "mai";|
	    6 : string := "juni";|
	    7 : string := "juillet";|
	    8 : string := "août";|
	    9 : string := "septembre";|
	   10 : string := "octobre";|
	   11 : string := "novembre";|
	   12 : string := "décembre";
	 ELSE
	 END;
         len := 9;|
     4 : CASE Monat OF
	    1 : string := "enero";|
	    2 : string := "febrero";|
	    3 : string := "marzo";|
	    4 : string := "abril";|
	    5 : string := "mayo";|
	    6 : string := "junio";|
	    7 : string := "julio";|
	    8 : string := "agosto";|
	    9 : string := "septiembre";|
	   10 : string := "octubre";|
	   11 : string := "noviembre";|
	   12 : string := "diciembre";
	 ELSE
	 END;
         len := 10;
   END;
   RETURN(len);
 END monat;


 PROCEDURE GetSysSec(Tag,Monat : SHORTCARD; Jahr : CARDINAL;
					 Std,Min,Sek : SHORTCARD) : LONGCARD;

 VAR
	(*days,secs	: LONGCARD;*)
	clock		: ClockData;

 BEGIN
   clock.sec := Sek;
   clock.min := Min;
   clock.hour := Std;
   clock.mday := Tag;
   clock.month := Monat;
   clock.year := Jahr;
   clock.wday := 0;
   RETURN(Date2Amiga(clock));
 (*secs := LONGCARD(Sek) + LONGCARD(Min * 60) + LONGCARD(Std * 3600);
   days := tagdiff(ErsterTag,ErsterMonat,ErstesJahr,Tag,Monat,Jahr);
   secs := secs + days * 24 * 60 * 60;
   RETURN(secs);*)
 END GetSysSec;


 PROCEDURE max(a,b : SHORTCARD) : SHORTCARD;

 BEGIN
   IF a > b THEN
     RETURN(a);
   ELSE
     RETURN(b);
   END;
 END max;


 BEGIN
   IF localeBase # NIL THEN
     lptr := OpenLocale(NIL);
     IF lptr # NIL THEN
       wlen := Length(str(GetLocaleStr(lptr,day1))^);
       wlen := max(wlen,Length(str(GetLocaleStr(lptr,day2))^));
       wlen := max(wlen,Length(str(GetLocaleStr(lptr,day3))^));
       wlen := max(wlen,Length(str(GetLocaleStr(lptr,day4))^));
       wlen := max(wlen,Length(str(GetLocaleStr(lptr,day5))^));
       wlen := max(wlen,Length(str(GetLocaleStr(lptr,day6))^));
       wlen := max(wlen,Length(str(GetLocaleStr(lptr,day7))^));
       mlen := Length(str(GetLocaleStr(lptr,mon1))^);
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon2))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon3))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon4))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon5))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon6))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon7))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon8))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon9))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon10))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon11))^));
       mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon12))^));
     END;
   END;
 CLOSE
   IF lptr # NIL THEN
     CloseLocale(lptr);
   END;
 END Datum.