MODULE  Datum;

IMPORT  Dos,st:Strings;

(*----------------------------------------------------------------------------*
 *
 * :Module.       TopTime
 * :Begin.        16 Sep 1992
 * :Finish.
 * :Author.       A. Günzel-Peltner
 * :Copyright.    Freeware
 * :Language.     OBERON
 * :Translator.   Amiga-Oberon V 2.14
 * :History.      Version 1.00 vom 16 Sep 1992
 * :Contents.     Rouitnen zum Wandlen Dos.Date und Intui.Time in Strings
 * :Imports.      Einige Routinen, die der Einfachheit halber mit eingebaut
                  wurden.
 * :Bugs.         Routinen laufen nur mit Amiga-DAtum, also
 *                ab 01.01.1978 bis 31.12.2077
 *
 *----------------------------------------------------------------------------*)

TYPE  WoTag = ARRAY 4,7,10 OF CHAR;
CONST WT    = WoTag("Sonntag","Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
                    "Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday",
                    "SO","MO","DI","MI","DO","FR","SA",
                    "Sun","Mon","Tue","Wed","Thu","Fri","Sat");
TYPE
  DatumStruct * = STRUCT;
    Jahr    *: LONGINT;  (* Jahr,   zB 1992 *)
    Monat   *: LONGINT;  (* Monat,  zB 12 *)
    Tag     *: LONGINT;  (* Tag,    zB 31 *)
    Stunde  *: LONGINT;  (* Stunde, zB 23 *)
    Minute  *: LONGINT;  (* Minute, zB 59 *)
    Sekunde *: LONGINT;  (* Sekunde,zB 59 *)
    Ticks   *: LONGINT;  (* Rest von Sekunde in Ticks (1/50-Sekunde )         *)
    Micros  *: LONGINT;  (* Rest von Sekunde in MicroSek (Nicht von Ticks)    *)
    WoTa    *: LONGINT;  (* Wochentag 0-7, 0=Sonntag, 1=Montag usw.           *)
    (* Not Used yet (Keine Berechnungsroutinen vorhanden )                    *)
    Woche   : LONGINT;  (* Nummer der Woche im Jahr                           *)
    Samstag : BOOLEAN;  (* Samstag = TRUE                                     *)
    FeTa    : BOOLEAN;  (* Sonn/Bundes-feiertag = TRUE                        *)
  END;

CONST
  (* Datumsinhalt für das Inhalts-LONGSET                                     *)
  (* Je nach gesetzten Flags, wird der Datums-Strings generiert               *)
  jahr2   *=0;  stunde  *=4;  wotaL   *=8;
  jahr4   *=1;  minute  *=5;  (* 9-29 frei -> future   *)
  monat   *=2;  sekunde *=6;                deutsch *=31;
  tag     *=3;  wota2   *=7;                english *=30;

  (* Macros *)
  fulldate  *= LONGSET{wotaL,jahr4,monat,tag,stunde,minute,sekunde};
  fulldateD *= fulldate + LONGSET{deutsch};
  fulldateE *= fulldate + LONGSET{english};

  quickdate  *= LONGSET{jahr2,monat,tag,stunde,minute,sekunde};
  quickdateD *= fulldate + LONGSET{deutsch};
  quickdateE *= fulldate + LONGSET{english};

  day = 24*60*60; (* ein Tag in Sekunden *)
  min = 60;       (* Minute ins Sekunden *)

(*----------------------------------------------------------------------------*
  Die  folgenden  Routinen  gehören  NICHT zu Datum.mod, werden aber benutzt.
  Dabei handelt es sich um eigene oder verbesserte/geänderte Routinen anderer
  Autoren.
 *----------------------------------------------------------------------------*)

PROCEDURE AppendChar (VAR S:ARRAY OF CHAR;C:CHAR);
(* sicherer als das Strings-Original, aber kompatibel *)
VAR x:INTEGER;
BEGIN
  x := st.Length(S);
  IF x<LEN(S) THEN
    S[x]:=C;
    INC(x);
    IF x<LEN(S) THEN
      S[x]:=0X;
    END;
  END;
END AppendChar;

PROCEDURE CopyStr (Source:ARRAY OF CHAR;VAR Dest:ARRAY OF CHAR);
(* $CopyArrays-*)
(* Ersatz für COPY(), füllt Rest von Destination mit 0-Bytes    *)
VAR   Pos,Max,Des : INTEGER;
BEGIN
  Max:=LEN(Source);
  IF LEN(Dest)<Max THEN Max:=LEN(Dest) END;
  DEC(Max);
  Pos:=0;
  LOOP
    Dest[Pos]:=Source[Pos];
    INC(Pos);
    IF (Pos>Max) OR (Source[Pos]=0X) THEN
      IF Pos<LEN(Dest) THEN
        Des := LEN(Dest);
        WHILE Pos<Des DO
          Dest[Pos]:=0X;
          INC(Pos);
        END;
      END;
      EXIT;
    END;
  END;
END CopyStr;

PROCEDURE IntToString (    int: LONGINT;
                       VAR str: ARRAY OF CHAR;
                             n: INTEGER;
                           nul: BOOLEAN;
                           sig: BOOLEAN): BOOLEAN;
(*    Replace des originals :                                                 *)
(*    nul=TRUE  - stellt Nullen voran,                                        *)
(*    sig=FALSE - durckt Vorzeichen nicht (auch keinne Platzhalter)           *)
VAR
  mi: BOOLEAN;
  c: INTEGER;
  x: INTEGER;

BEGIN
  (* Vorzeichenfeld weg *)
  IF sig THEN x:=0 ELSE x:=-1; DEC(n) END;
  str[n+1] := 0X; mi := FALSE;
  mi := int=MIN(LONGINT);
  IF mi THEN int := MIN(LONGINT)+1000000000 END;
  IF int<0 THEN
    int := -int;
    IF sig THEN str[0] := "-" ELSE str[0] := " " END;
  END;
  c := n;
  WHILE c>x DO
    str[c] := CHR(int MOD 10 + ORD("0"));
    int := int DIV 10;
    DEC(c);
  END;
  LOOP
    INC(c);
    IF (str[c]#"0") OR (c=n) THEN EXIT END;
    IF nul THEN str[c] := "0" ELSE str[c] := " " END;
  END;
  IF mi THEN INC(str[c]) END;
  RETURN int=0;
END IntToString;

(*----------------------------------------------------------------------------*
                            Datums-Routinen
 *----------------------------------------------------------------------------*)

PROCEDURE DateToDatum*(Date:Dos.Date;VAR Datum:DatumStruct);
(*Erklärung:   Diese Routine wandelt ein Datum vom Typ Dos.Date in das eigene *)
(*Datumsformat.                                                               *)

VAR GesamtTage,Rest,
    Jahre,SchaltJahre,
    x1,a,b,c          :LONGINT;
    Schaltjahr,ok     :BOOLEAN;

BEGIN
  GesamtTage     := Date.days;
  SchaltJahre    :=((GesamtTage DIV 365)+2) DIV 4;
  IF ((GesamtTage DIV 365)+2) MOD 4 = 0 THEN
    Schaltjahr := TRUE;
  ELSE
    Schaltjahr := FALSE;
  END;
  Jahre:=(GesamtTage-SchaltJahre) DIV 365;
  Datum.Jahr := 1978 + Jahre;
  IF Schaltjahr THEN
    Rest := GesamtTage-(Jahre*365+SchaltJahre-1);
  ELSE
    Rest := GesamtTage-(Jahre*365+SchaltJahre);
  END;
  INC(Rest);
  IF Schaltjahr THEN x1:= 366 ELSE x1:= 365 END;

  IF    Rest > (x1-31)  THEN Datum.Monat := 12; Datum.Tag := Rest-(x1-31);
  ELSIF Rest > (x1-61)  THEN Datum.Monat := 11; Datum.Tag := Rest-(x1-61);
  ELSIF Rest > (x1-92)  THEN Datum.Monat := 10; Datum.Tag := Rest-(x1-92);
  ELSIF Rest > (x1-122) THEN Datum.Monat := 9;  Datum.Tag := Rest-(x1-122);
  ELSIF Rest > (x1-153) THEN Datum.Monat := 8;  Datum.Tag := Rest-(x1-153);
  ELSIF Rest > (x1-184) THEN Datum.Monat := 7;  Datum.Tag := Rest-(x1-184);
  ELSIF Rest > (x1-214) THEN Datum.Monat := 6;  Datum.Tag := Rest-(x1-214);
  ELSIF Rest > (x1-245) THEN Datum.Monat := 5;  Datum.Tag := Rest-(x1-245);
  ELSIF Rest > (x1-275) THEN Datum.Monat := 4;  Datum.Tag := Rest-(x1-275);
  ELSIF Rest > (x1-306) THEN Datum.Monat := 3;  Datum.Tag := Rest-(x1-306);
  ELSIF (Schaltjahr)  AND (Rest > (x1-335)) THEN
        Datum.Monat := 2;
        Datum.Tag := Rest -(x1-335);
  ELSIF (NOT Schaltjahr) AND (Rest > (x1-334)) THEN
        Datum.Monat := 2;
        Datum.Tag := Rest -(x1-334);
  ELSE  Datum.Monat:= 1;
        Datum.Tag := Rest ;
  END; (*IF*)

  Datum.Stunde        := Date.minute DIV 60;
  Datum.Minute        := Date.minute MOD 60;
  Datum.Sekunde       := Date.tick DIV 50;
  Datum.Ticks         := Date.tick MOD 50;
  Datum.Micros        := Datum.Ticks * 20;

  IF Datum.Monat > 2 THEN
    a := Datum.Jahr MOD 100;
    c := Datum.Jahr DIV 100;
    b := (13*(Datum.Monat-2) - 1) DIV 5 + a DIV 4 + c DIV 4;
  ELSE
    a := (Datum.Jahr-1) MOD 100;
    c := (Datum.Jahr-1) DIV 100;
    b := (13*(Datum.Monat+10) - 1) DIV 5 + a DIV 4 + c DIV 4;
  END;
  Datum.WoTa := (b+a+Datum.Tag-2*c) MOD 7;

  (* Wochenbrechnung fehlt noch *)

  (* Feiertagsroutine fehlt noch, Sonntage werden gesetzt *)

  IF Datum.WoTa=1 THEN
      Datum.Samstag := TRUE;
      Datum.FeTa    := FALSE;
  ELSIF Datum.WoTa=1 THEN
    Datum.Samstag := FALSE;
    Datum.FeTa    := TRUE;
  ELSE
    Datum.Samstag := FALSE;
    Datum.FeTa    := FALSE;
  END;
END DateToDatum;

(*----------------------------------------------------------------------------*)
PROCEDURE TimeToDate * (secs,micros:LONGINT;VAR Date:Dos.Date);
(*Erklärung:   Diese  Routine wandelt zwei Longint Zahlen in das Format von   *)
(*Dos.Date.   secs  beinhaltet  die  Zeit  in  Sekunden und micros die Anzahl *)
(*Microsekunden  bis  zur  nächsten  Sekunden.   Dieses Format entspricht den *)
(*Aufrufen von Intuition.CurrentTime und dem TimeVal des Timer.devices.       *)
BEGIN
  Date.days   :=  secs  DIV day;                  (* Sekunden in Tage *)
  Date.minute := (secs  MOD day) DIV min;         (* Rest in Minuten  *)
  Date.tick   := ((secs MOD day) MOD min)*50;     (* Rest in 1/50 Sek *)
  INC(Date.tick,(micros DIV 20000));              (* Dazu ganze 1/50S *)
  (* Rest an Micros wird ignoriert, eh recht ungenau                  *)
END TimeToDate;


(*----------------------------------------------------------------------------*)
PROCEDURE TimeToDatum*(secs,micros:LONGINT;VAR Datum:DatumStruct);
(*Erklärung:   Diese  Routine  wandelt  zwei  Longint  Zahlen  in  das eigene *)
(*Datumsformat. secs  beinhaltet  die  Zeit in Sekunden und micros die Anzahl *)
(*Microsekunden  bis  zur  nächsten  Sekunden.   Dieses Format entspricht den *)
(*Aufrufen von Intuition.CurrentTime und dem TimeVal des Timer.devices.       *)
VAR Date: Dos.Date;
BEGIN
  TimeToDate(secs,micros,Date);              (* in Dos.Date wandeln *)
  DateToDatum (Date,Datum);                  (* in Datum wandeln    *)
  INC(Datum.Micros,micros MOD 20000);        (* Restmircros, werden unterdrückt *)
END TimeToDatum;

(*----------------------------------------------------------------------------*)
PROCEDURE DatumToString*(     Datum : DatumStruct;
                          VAR String: ARRAY OF CHAR;
                              Inhalt: LONGSET);
(*Datum  im  Format  WoTa(L|K) TT.MM.JJ(JJ) HH:MM:SS.  Bestimmte Teile können *)
(*weggelassen  werden, was durch das InhaltsSet bestimmt wird Je nach Sprache *)
(*wird  der  Wochentag  eingefügt.   Als  Datum wird das interne Datumsformat *)
(*verwendet, das man mit den obigen Proceduren wandeln kann.                  *)
(*Datum wird verändert, darf KEIN VAR-Paramter werden                         *)
VAR pos:INTEGER;
    max:INTEGER;
    dat:ARRAY 6 OF CHAR;
    x  :INTEGER;
BEGIN
  max := LEN(String)-1;
  pos := 0;

  IF (wota2 IN Inhalt) AND (pos<(max-3)) THEN
    IF english IN Inhalt THEN x:=3 ELSE x:=2 END;
    CopyStr(WT[x,Datum.WoTa],String);
    INC(pos,2);

  ELSIF wotaL IN Inhalt THEN
    IF english IN Inhalt THEN x:=1 ELSE x:=0 END;
    pos := st.Length(WT[x,Datum.WoTa])+1;
    IF pos<max THEN
      CopyStr(WT[x,Datum.WoTa],String);
      String[pos-1]:=" ";
    ELSE
      pos:=0;
    END;
  END;

  IF (tag IN Inhalt) AND (pos<(max-3)) THEN
    IF IntToString (Datum.Tag,dat,2,TRUE,FALSE) THEN
      String[pos]:=dat[0];INC(pos);
      String[pos]:=dat[1];INC(pos);
      String[pos]:=".";INC(pos);
    END;
  END;

  IF (monat IN Inhalt) AND (pos<(max-3)) THEN
    IF IntToString (Datum.Monat,dat,2,TRUE,FALSE) THEN
      String[pos]:=dat[0];INC(pos);
      String[pos]:=dat[1];INC(pos);
      String[pos]:=".";INC(pos);
    END;
  END;

  IF (jahr2 IN Inhalt) AND (pos<(max-3)) THEN
    IF Datum.Jahr>1999 THEN
      DEC(Datum.Jahr,2000);
    ELSE
      DEC(Datum.Jahr,1900);
    END;
    IF IntToString (Datum.Jahr,dat,2,TRUE,FALSE) THEN
      String[pos]:=dat[0];INC(pos);
      String[pos]:=dat[1];INC(pos);
    END;
  ELSIF (jahr4 IN Inhalt) AND (pos<(max-4)) THEN
    IF IntToString (Datum.Jahr,dat,4,TRUE,FALSE) THEN
      String[pos]:=dat[0];INC(pos);
      String[pos]:=dat[1];INC(pos);
      String[pos]:=dat[2];INC(pos);
      String[pos]:=dat[3];INC(pos);
    END;
  END;

 (* leeraum zwischen Datum und Uhrzeit *)
 IF (pos>0) AND (pos<max) THEN String[pos]:=" ";INC(pos);END;

  IF (stunde IN Inhalt) AND (pos<(max-3)) THEN
    IF IntToString (Datum.Stunde,dat,2,TRUE,FALSE) THEN
      String[pos]:=dat[0];INC(pos);
      String[pos]:=dat[1];INC(pos);
      String[pos]:=":";INC(pos);
    END;
  END;

  IF (minute IN Inhalt) AND (pos<(max-3)) THEN
    IF IntToString (Datum.Minute,dat,2,TRUE,FALSE) THEN
      String[pos]:=dat[0];INC(pos);
      String[pos]:=dat[1];INC(pos);
      String[pos]:=":";INC(pos);
    END;
  END;

  IF (sekunde IN Inhalt) AND (pos<(max-2)) THEN
    IF IntToString (Datum.Sekunde,dat,2,TRUE,FALSE) THEN
      String[pos]:=dat[0];INC(pos);
      String[pos]:=dat[1];INC(pos);
    END;
  END;

  String[pos]:=0X;
  DEC(pos);
  IF NOT((String[pos]>="0")AND(String[pos]<="9"))THEN
    (* Letztes Zeichen ist keine Zahl *)
    String[pos]:=0X;
  END;
END DatumToString;

(*----------------------------------------------------------------------------*
   ACHTUNG DIE FOLGENDEN ZWEI PROCEDUREN LAUFEN NUR MIT KICK 2.00 ODER HÖHER
 *----------------------------------------------------------------------------*)

PROCEDURE DateToDosString*(     Date  : Dos.Date;
                            VAR String: ARRAY OF CHAR;
                                Format: SHORTINT;
                                Flags : SHORTSET);
(*Erklärung:    Diese   Routine   erzeugt  einen  Dos-Datums-String  mit  den *)
(*vorgegebenen  Datum/Uhrzeit  und  den  Paramtern.   Die  Paramter  sind dem *)
(*Dos-Interface zu entnehmen.  Das Datum wird in einem String zurückgegeben.  *)
VAR Datum:Dos.DateTime;
BEGIN
  NEW(Datum.strDay ); (* Keine Erfolgsabfrage, da nur 16 Byte nötig *)
  NEW(Datum.strDate);
  NEW(Datum.strTime);
  Datum.stamp.days  := Date.days  ;
  Datum.stamp.minute:= Date.minute;
  Datum.stamp.tick  := Date.tick  ;
  Datum.format := Format;
  Datum.flags  := Flags;
  IF Dos.DateToStr(Datum) THEN
    IF LEN(String)>(SIZE(Datum.strDay^)+SIZE(Datum.strDate^)+SIZE(Datum.strTime^)) THEN
      CopyStr(Datum.strDay^,String);
      AppendChar(String," ");
      st.Append(String,Datum.strDate^);
      st.Append(String,Datum.strTime^);
    ELSE
      String := "String zu kurz";
    END;
  ELSE
    String := "Fehlerhaftes Datum";
  END;
END DateToDosString;

(*----------------------------------------------------------------------------*)
PROCEDURE TimeToDosString*(     secs,
                                micros: LONGINT;
                            VAR String: ARRAY OF CHAR;
                                Format: SHORTINT;
                                Flags : SHORTSET);
(*Erklärung:    Diese   Routine   wandelt   zwei   Longint   Zahlen  in  eine *)
(*Dos-Datums-String.   secs  beinhaltet  die  Zeit in Sekunden und micros die *)
(*Anzahl  Microsekunden  bis zur nächsten Sekunden.  Dieses Format entspricht *)
(*den Aufrufen von Intuition.CurrentTime und dem TimeVal des Timer.devices.   *)
(* Dabei werden bereits erklärte Routinen verwendet                           *)
VAR Date:Dos.Date;
BEGIN
  TimeToDate (secs,micros,Date);
  DateToDosString(Date,String,Format,Flags);
END TimeToDosString;

(*----------------------------------------------------------------------------*)
END Datum.