home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / util / misc / kalender / txt / datum.mod < prev    next >
Text File  |  1994-01-15  |  14KB  |  506 lines
  1.  IMPLEMENTATION MODULE Datum; (* Copyright 1993 by Kai Hofmann *)
  2.  
  3.  (*$ StackChk    := FALSE *)
  4.  (*$ RangeChk    := FALSE *)
  5.  (*$ OverflowChk := FALSE *)
  6.  (*$ NilChk      := FALSE *)
  7.  (*$ CaseChk     := FALSE *)
  8.  (*$ ReturnChk   := FALSE *)
  9.  (*$ LargeVars   := FALSE *)
  10.  (*$ EntryClear  := TRUE  *)
  11.  (*$ Volatile    := TRUE  *)
  12.  (*$ StackParms  := TRUE  *)
  13.  (*$ CStrings    := TRUE  *)
  14.  
  15.  
  16.  FROM SYSTEM        IMPORT    ADR,ADDRESS;
  17.  FROM IntuitionL    IMPORT    CurrentTime;
  18.  FROM Conversions    IMPORT    ValToStr;
  19.  FROM String        IMPORT    Concat,Length,Copy;
  20.  FROM UtilityD        IMPORT    ClockData;
  21.  FROM UtilityL        IMPORT    Amiga2Date,Date2Amiga(*,CheckDate*);
  22.  FROM LocaleD        IMPORT    day1,day2,day3,day4,day5,day6,day7,
  23.                 mon1,mon2,mon3,mon4,mon5,mon6,mon7,mon8,mon9,
  24.                 mon10,mon11,mon12,
  25.                 LocalePtr,Locale;
  26.  FROM LocaleL        IMPORT    localeBase,GetLocaleStr,OpenLocale,CloseLocale;
  27.  
  28.  
  29.  TYPE
  30.     str    = POINTER TO ARRAY [0..20] OF CHAR;
  31.  
  32.  
  33.  CONST
  34.     ErsterTag    =    1; (* Ab diesem Datum fängt die Systemzeit *)
  35.      ErsterMonat    =    1; (* an zu zählen.                        *)
  36.      ErstesJahr    = 1978;
  37.      ErsterWochentag =    7;
  38.  
  39.  
  40.  VAR
  41.     wlen,mlen    : SHORTCARD;
  42.     lstr        : ADDRESS;
  43.     lptr        : LocalePtr;
  44.  
  45.  
  46.  PROCEDURE GetSeconds() : LONGCARD;    (* Holt die Systemzeit des Amiga *)
  47.                     (* in Sekunden             *)
  48.  VAR
  49.     sekunden,microsek : LONGCARD;
  50.  
  51.  BEGIN
  52.    CurrentTime(ADR(sekunden),ADR(microsek));
  53.    RETURN sekunden;
  54.  END GetSeconds;
  55.  
  56.  
  57.  PROCEDURE Schaltjahr(Jahr : CARDINAL) : BOOLEAN; (* Ermittelt, ob es sich *)
  58.                           (* bei Jahr um ein       *)
  59.  BEGIN                          (* Schaltjahr handelt    *)
  60.    IF (Jahr MOD 4 = 0) AND ((Jahr MOD 100 > 0) OR ((Jahr MOD 400 = 0) AND (Jahr MOD 3200 > 0))) THEN
  61.      RETURN(TRUE);
  62.    ELSE
  63.      RETURN(FALSE);
  64.    END;
  65.  END Schaltjahr;
  66.  
  67. (*
  68.  PROCEDURE Year(VAR Tag : LONGCARD) : CARDINAL; (* Ermittelt das Jahr durch   *)
  69.                             (* umrechnung der anzahl Tage *)
  70.  VAR
  71.     JAHR : CARDINAL;               (* die seit dem Systemstart   *)
  72.                            (* (siehe CONST) vergangen    *)
  73.  BEGIN                           (* sind.                 *)
  74.    INC(Tag);
  75.    JAHR := ErstesJahr;
  76.    REPEAT
  77.      Tag := Tag - 365;
  78.      IF Schaltjahr(JAHR) THEN
  79.        DEC(Tag);
  80.      END;
  81.      INC(JAHR);
  82.    UNTIL ((Tag <= 365) AND (NOT Schaltjahr(JAHR))) OR
  83.                     (Schaltjahr(JAHR) AND (Tag <= 366));
  84.    RETURN(JAHR);
  85.  END Year;
  86. *)
  87.  
  88.  PROCEDURE maxDays(Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD; (* Ermittelt die Anzahl *)
  89.                             (* von Tagen, welche es *)
  90.  BEGIN                            (* in einem Monat gibt. *)
  91.    IF Monat IN {1,3,5,7,8,10,12} THEN            (* bei einem falschen   *)
  92.      RETURN(31);                    (* Monat wird 0 als     *)
  93.    ELSIF Monat IN {4,6,9,11} THEN            (* Fehler ausgegeben    *)
  94.      RETURN(30);
  95.    ELSIF (Monat = 2) AND Schaltjahr(Jahr) THEN
  96.      RETURN(29);
  97.    ELSIF (Monat = 2) AND (NOT Schaltjahr(Jahr)) THEN
  98.      RETURN(28);
  99.    ELSE
  100.      RETURN(0);
  101.    END;
  102.  END maxDays;
  103.  
  104. (*
  105.  PROCEDURE Month(VAR Tag : LONGCARD; Jahr : CARDINAL) : SHORTCARD; (* Ermittelt *)
  106.                                 (* den akt.  *)
  107.  VAR                                (* Monat.    *)
  108.     MONAT : SHORTCARD;
  109.  
  110.  BEGIN
  111.    MONAT := ErsterMonat;
  112.    WHILE Tag > maxDays(MONAT,Jahr) DO
  113.      Tag := Tag - maxDays(MONAT,Jahr);
  114.      INC(MONAT);
  115.    END;
  116.    RETURN(MONAT);
  117.  END Month;
  118. *)
  119.  
  120.  PROCEDURE Weekday (Tag,Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD;(* Ermittelt aus dem *)
  121.                             (* Datum den Wochen- *)
  122.  VAR                            (* tag. (1 = Montag) *)
  123.     JAHR        : CARDINAL;
  124.     WOCHENTAG    : CARDINAL;
  125.     MONAT        : SHORTCARD;
  126.  
  127.  BEGIN
  128.    WOCHENTAG := ErsterWochentag;
  129.    JAHR := ErstesJahr;
  130.    WHILE JAHR < Jahr DO
  131.      INC(JAHR);
  132.      INC(WOCHENTAG);
  133.      IF Schaltjahr(JAHR) AND (JAHR # Jahr) THEN
  134.        INC(WOCHENTAG);
  135.      END;
  136.    END;
  137.    MONAT := 1;
  138.    WHILE MONAT < Monat DO
  139.      WOCHENTAG := WOCHENTAG + maxDays(MONAT,Jahr);
  140.      INC(MONAT);
  141.    END;
  142.    WOCHENTAG := WOCHENTAG + Tag - 1;
  143.    WOCHENTAG := WOCHENTAG MOD 7;
  144.    IF WOCHENTAG = 0 THEN
  145.      WOCHENTAG := 7;
  146.    END;
  147.    RETURN(SHORTCARD(WOCHENTAG));
  148.  END Weekday;
  149.  
  150.  
  151.  PROCEDURE GetDate (VAR Wochentag,Tag,Monat : SHORTCARD; VAR Jahr : CARDINAL);(* Holt das      *)
  152.                                 (* aktuelle Datum*)
  153.  VAR
  154.     clock    : ClockData;
  155.     (*sekunden        : LONGCARD;
  156.     Sekunde,Minute,Stunde    : SHORTCARD;*)
  157.  
  158.  BEGIN
  159.    Amiga2Date(GetSeconds(),clock);
  160.    Tag := clock.mday;
  161.    Monat := clock.month;
  162.    Jahr := clock.year;
  163.    Wochentag := clock.wday;
  164.    IF Wochentag = 0 THEN
  165.      Wochentag := 7;
  166.    END;
  167.  (*sekunden    := GetSeconds();
  168.    Sekunde    := sekunden - (sekunden DIV 60) * 60;
  169.    sekunden    := (sekunden - Sekunde) DIV 60;
  170.    Minute    := sekunden - (sekunden DIV 60) * 60;
  171.    sekunden    := (sekunden - Minute) DIV 60;
  172.    Stunde    := sekunden - (sekunden DIV 24) * 24;
  173.    sekunden    := (sekunden - Stunde) DIV 24;
  174.    Jahr        := Year(sekunden);
  175.    Monat    := Month(sekunden,Jahr);
  176.    Tag        := sekunden;
  177.    Wochentag    := Weekday(Tag,Monat,Jahr);*)
  178.  END GetDate;
  179.  
  180.  
  181.  PROCEDURE GetTime (VAR Stunde,Minute,Sekunde : SHORTCARD);(* Holt die aktuelle*)
  182.                              (* Uhrzeit.         *)
  183.  VAR
  184.     clock    : ClockData;
  185.     (*sekunden : LONGCARD;*)
  186.  
  187.  BEGIN
  188.    Amiga2Date(GetSeconds(),clock);
  189.    Stunde := clock.hour;
  190.    Minute := clock.min;
  191.    Sekunde := clock.sec;
  192.  (*sekunden  := GetSeconds();
  193.    Sekunde   := sekunden - (sekunden DIV 60) * 60;
  194.    sekunden  := (sekunden - Sekunde) DIV 60;
  195.    Minute    := sekunden - (sekunden DIV 60) * 60;
  196.    sekunden  := (sekunden - Minute) DIV 60;
  197.    Stunde    := sekunden - (sekunden DIV 24) * 24;*)
  198.  END GetTime;
  199.  
  200.  
  201.  PROCEDURE tagdiff(tag1,monat1 : SHORTCARD; jahr1 : CARDINAL; tag2,monat2 : SHORTCARD; jahr2 : CARDINAL) : LONGINT;
  202.                         (* Berechnet die       *)
  203.  VAR                        (* differnenz zwischen *)
  204.     t1,t2 : LONGCARD;            (* zwei Daten in Tagen *)
  205.                         (* Datum1 > Datum2     *)
  206.  BEGIN                        (* ergibt negatives    *)
  207.    t1 := tag1;                    (* Ergebnis           *)
  208.    t2 := tag2;
  209.    WHILE monat1 > 1 DO
  210.      DEC(monat1);
  211.      t1 := t1 + maxDays(monat1,jahr1);
  212.    END;
  213.    WHILE monat2 > 1 DO
  214.      DEC(monat2);
  215.      t2 := t2 + maxDays(monat2,jahr2);
  216.    END;
  217.    WHILE jahr1 > jahr2 DO
  218.      t1 := t1 + 365;
  219.      DEC(jahr1);
  220.      IF Schaltjahr(jahr1) THEN
  221.        INC(t1);
  222.      END;
  223.    END;
  224.    WHILE jahr2 > jahr1 DO
  225.      t2 := t2 + 365;
  226.      DEC(jahr2);
  227.      IF Schaltjahr(jahr2) THEN
  228.        INC(t2);
  229.      END;
  230.    END;
  231.    RETURN(t2-t1);
  232.  END tagdiff;
  233.  
  234.  
  235.  PROCEDURE wochentag(Tag : SHORTCARD; VAR string : wtstring;
  236.                       Sprache : SHORTCARD) : SHORTCARD;
  237.                                 (* Gibt den      *)
  238.  VAR                                (* Wochentag als *)
  239.     len : SHORTCARD;                    (* Text zurück   *)
  240.  
  241.  BEGIN
  242.    string := "";
  243.    CASE Sprache OF
  244.      0 : CASE Tag OF
  245.            1 : Copy(string,str(GetLocaleStr(lptr,day2))^); |
  246.            2 : Copy(string,str(GetLocaleStr(lptr,day3))^); |
  247.            3 : Copy(string,str(GetLocaleStr(lptr,day4))^); |
  248.            4 : Copy(string,str(GetLocaleStr(lptr,day5))^); |
  249.            5 : Copy(string,str(GetLocaleStr(lptr,day6))^); |
  250.            6 : Copy(string,str(GetLocaleStr(lptr,day7))^); |
  251.            7 : Copy(string,str(GetLocaleStr(lptr,day1))^); |
  252.          ELSE
  253.          END;
  254.          len := wlen;|
  255.      1 : CASE Tag OF
  256.        1 : string := "monday";    |
  257.        2 : string := "tuesday";   |
  258.        3 : string := "wednesday"; |
  259.        4 : string := "thursday";  |
  260.        5 : string := "freiday";   |
  261.        6 : string := "saturday";  |
  262.        7 : string := "sunday";
  263.      ELSE
  264.      END;
  265.          len := 9;|
  266.      2 : CASE Tag OF
  267.        1 : string := "Montag";     |
  268.        2 : string := "Dienstag";   |
  269.        3 : string := "Mittwoch";   |
  270.        4 : string := "Donnerstag"; |
  271.        5 : string := "Freitag";    |
  272.        6 : string := "Samstag";    |
  273.        7 : string := "Sonntag";
  274.      ELSE
  275.      END;
  276.          len := 10;|
  277.      3 : CASE Tag OF
  278.        1 : string := "lundi";   |
  279.        2 : string := "mardi";   |
  280.        3 : string := "mercredi";|
  281.        4 : string := "jeudi";   |
  282.        5 : string := "vendredi";|
  283.        6 : string := "samedi";  |
  284.        7 : string := "dimanche";
  285.      ELSE
  286.      END;
  287.          len := 8;|
  288.      4 : CASE Tag OF
  289.        1 : string := "lunes";     |
  290.        2 : string := "martes";    |
  291.        3 : string := "miércoles";|
  292.        4 : string := "jueves";    |
  293.        5 : string := "viernes";   |
  294.        6 : string := "sábado";   |
  295.        7 : string := "domingo";
  296.      ELSE
  297.      END;
  298.          len := 9;
  299.    END;
  300.    RETURN(len);
  301.  END wochentag;
  302.  
  303.  
  304.  PROCEDURE GetWeek(Tag,Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD;
  305.  
  306.  VAR week : SHORTCARD;
  307.      wt   : SHORTCARD;
  308.  
  309.  BEGIN
  310.     wt := Weekday(1,1,Jahr);
  311.     IF wt = 1 THEN
  312.       week := tagdiff(1,1,Jahr,Tag,Monat,Jahr) DIV 7 +1;
  313.     ELSE
  314.       week := tagdiff(9-wt,1,Jahr,Tag,Monat,Jahr);
  315.       IF week < 0 THEN
  316.         week := GetWeek(31,12,Jahr-1);
  317.       ELSE
  318.         week := week DIV 7 +1;
  319.       END;
  320.     END;
  321.     RETURN(week);
  322.  END GetWeek;
  323.  
  324.  
  325.  PROCEDURE FormatDate(Tag,Monat : SHORTCARD; Jahr : CARDINAL; VAR datum : datestr);
  326.  
  327.  VAR tag,monat    : ARRAY [1..3] OF CHAR;
  328.      jahr    : ARRAY [1..5] OF CHAR;
  329.      err    : BOOLEAN;
  330.  
  331.  BEGIN
  332.    IF datum[0] = 'l' THEN
  333.      (* use locale.library *)
  334.    ELSE
  335.      datum := "";
  336.      ValToStr(Tag,FALSE,tag,10,2,'0',err);
  337.      ValToStr(Monat,FALSE,monat,10,2,'0',err);
  338.      ValToStr(Jahr,FALSE,jahr,10,4,'0',err);
  339.      Concat(datum,tag);
  340.      Concat(datum,".");
  341.      Concat(datum,monat);
  342.      Concat(datum,".");
  343.      Concat(datum,jahr);
  344.    END;
  345.  END FormatDate;
  346.  
  347.  
  348.  PROCEDURE monat(Monat : SHORTCARD; VAR string : wtstring;
  349.                     Sprache : SHORTCARD) : SHORTCARD;
  350.  
  351.  VAR
  352.     len : SHORTCARD;
  353.  
  354.  BEGIN
  355.    string := "";
  356.    CASE Sprache OF
  357.      0 : CASE Monat OF
  358.             1 : Copy(string,str(GetLocaleStr(lptr,mon1))^); |
  359.             2 : Copy(string,str(GetLocaleStr(lptr,mon2))^); |
  360.             3 : Copy(string,str(GetLocaleStr(lptr,mon3))^); |
  361.             4 : Copy(string,str(GetLocaleStr(lptr,mon4))^); |
  362.             5 : Copy(string,str(GetLocaleStr(lptr,mon5))^); |
  363.             6 : Copy(string,str(GetLocaleStr(lptr,mon6))^); |
  364.             7 : Copy(string,str(GetLocaleStr(lptr,mon7))^); |
  365.             8 : Copy(string,str(GetLocaleStr(lptr,mon8))^); |
  366.             9 : Copy(string,str(GetLocaleStr(lptr,mon9))^); |
  367.            10 : Copy(string,str(GetLocaleStr(lptr,mon10))^);|
  368.            11 : Copy(string,str(GetLocaleStr(lptr,mon11))^);|
  369.            12 : Copy(string,str(GetLocaleStr(lptr,mon12))^);|
  370.          ELSE
  371.          END;
  372.          len := mlen;|
  373.      1 : CASE Monat OF
  374.         1 : string := "january";|
  375.         2 : string := "february";|
  376.         3 : string := "march";|
  377.         4 : string := "april";|
  378.         5 : string := "may";|
  379.         6 : string := "june";|
  380.         7 : string := "july";|
  381.         8 : string := "august";|
  382.         9 : string := "september";|
  383.        10 : string := "october";|
  384.        11 : string := "november";|
  385.        12 : string := "december";
  386.      ELSE
  387.      END;
  388.          len := 9;|
  389.      2 : CASE Monat OF
  390.         1 : string := "Januar";|
  391.         2 : string := "Februar";|
  392.         3 : string := "März";|
  393.         4 : string := "April";|
  394.         5 : string := "Mai";|
  395.         6 : string := "Juni";|
  396.         7 : string := "Juli";|
  397.         8 : string := "August";|
  398.         9 : string := "September";|
  399.        10 : string := "Oktober";|
  400.        11 : string := "November";|
  401.        12 : string := "Dezember";
  402.      ELSE
  403.      END;
  404.          len := 9;|
  405.      3 : CASE Monat OF
  406.         1 : string := "janvier";|
  407.         2 : string := "février";|
  408.         3 : string := "mars";|
  409.         4 : string := "avril";|
  410.         5 : string := "mai";|
  411.         6 : string := "juni";|
  412.         7 : string := "juillet";|
  413.         8 : string := "août";|
  414.         9 : string := "septembre";|
  415.        10 : string := "octobre";|
  416.        11 : string := "novembre";|
  417.        12 : string := "décembre";
  418.      ELSE
  419.      END;
  420.          len := 9;|
  421.      4 : CASE Monat OF
  422.         1 : string := "enero";|
  423.         2 : string := "febrero";|
  424.         3 : string := "marzo";|
  425.         4 : string := "abril";|
  426.         5 : string := "mayo";|
  427.         6 : string := "junio";|
  428.         7 : string := "julio";|
  429.         8 : string := "agosto";|
  430.         9 : string := "septiembre";|
  431.        10 : string := "octubre";|
  432.        11 : string := "noviembre";|
  433.        12 : string := "diciembre";
  434.      ELSE
  435.      END;
  436.          len := 10;
  437.    END;
  438.    RETURN(len);
  439.  END monat;
  440.  
  441.  
  442.  PROCEDURE GetSysSec(Tag,Monat : SHORTCARD; Jahr : CARDINAL;
  443.                      Std,Min,Sek : SHORTCARD) : LONGCARD;
  444.  
  445.  VAR
  446.     (*days,secs    : LONGCARD;*)
  447.     clock        : ClockData;
  448.  
  449.  BEGIN
  450.    clock.sec := Sek;
  451.    clock.min := Min;
  452.    clock.hour := Std;
  453.    clock.mday := Tag;
  454.    clock.month := Monat;
  455.    clock.year := Jahr;
  456.    clock.wday := 0;
  457.    RETURN(Date2Amiga(clock));
  458.  (*secs := LONGCARD(Sek) + LONGCARD(Min * 60) + LONGCARD(Std * 3600);
  459.    days := tagdiff(ErsterTag,ErsterMonat,ErstesJahr,Tag,Monat,Jahr);
  460.    secs := secs + days * 24 * 60 * 60;
  461.    RETURN(secs);*)
  462.  END GetSysSec;
  463.  
  464.  
  465.  PROCEDURE max(a,b : SHORTCARD) : SHORTCARD;
  466.  
  467.  BEGIN
  468.    IF a > b THEN
  469.      RETURN(a);
  470.    ELSE
  471.      RETURN(b);
  472.    END;
  473.  END max;
  474.  
  475.  
  476.  BEGIN
  477.    IF localeBase # NIL THEN
  478.      lptr := OpenLocale(NIL);
  479.      IF lptr # NIL THEN
  480.        wlen := Length(str(GetLocaleStr(lptr,day1))^);
  481.        wlen := max(wlen,Length(str(GetLocaleStr(lptr,day2))^));
  482.        wlen := max(wlen,Length(str(GetLocaleStr(lptr,day3))^));
  483.        wlen := max(wlen,Length(str(GetLocaleStr(lptr,day4))^));
  484.        wlen := max(wlen,Length(str(GetLocaleStr(lptr,day5))^));
  485.        wlen := max(wlen,Length(str(GetLocaleStr(lptr,day6))^));
  486.        wlen := max(wlen,Length(str(GetLocaleStr(lptr,day7))^));
  487.        mlen := Length(str(GetLocaleStr(lptr,mon1))^);
  488.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon2))^));
  489.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon3))^));
  490.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon4))^));
  491.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon5))^));
  492.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon6))^));
  493.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon7))^));
  494.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon8))^));
  495.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon9))^));
  496.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon10))^));
  497.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon11))^));
  498.        mlen := max(mlen,Length(str(GetLocaleStr(lptr,mon12))^));
  499.      END;
  500.    END;
  501.  CLOSE
  502.    IF lptr # NIL THEN
  503.      CloseLocale(lptr);
  504.    END;
  505.  END Datum.
  506.