home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / bbs / mar94 / util / misc / kalender.lha / Kalender / txt / Kalender.mod < prev    next >
Text File  |  1993-12-18  |  25KB  |  942 lines
  1.  MODULE Kalender; (* 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,LONGSET;
  17.  FROM ExecD        IMPORT    MsgPortPtr;
  18.  FROM ExecL        IMPORT    Wait;
  19.  FROM Arts        IMPORT    returnVal,wbStarted,Assert,Terminate;
  20.  FROM InOut        IMPORT    WriteCard,WriteLn,WriteString,WriteInt;
  21.  FROM FileSystem    IMPORT    Lookup, Close, ReadChar, File, Response,
  22.                 WriteChar;
  23.  FROM Storage        IMPORT    ALLOCATE,DEALLOCATE;
  24.  FROM String        IMPORT    first,last,noOccur,Occurs,Insert,Delete,Copy,
  25.                 Concat,Length,CopyPart;
  26.  FROM Conversions    IMPORT    ValToStr,StrToVal;
  27.  FROM Datum        IMPORT    GetDate,maxDays,wtstring,wochentag,tagdiff,
  28.                 Weekday,GetWeek,monat;
  29.  FROM Text        IMPORT    normal,reverse,normc2,revc2,normc1,revc1;
  30.  FROM Window2        IMPORT    action2,action2ptr,action2mem,OpenWin2,
  31.                 CloseWin2,ClearWin2,OutputWin2,HandleAction2;
  32.  FROM Commands        IMPORT    CheckOption,GetOptionParam,Killstr,
  33.                 string, strptr;
  34.  FROM ARexx        IMPORT    OpenRexxPort,CloseRexxPort,SendRexxMsg;
  35.  
  36.  
  37.  CONST
  38.     maxstr    = 173 (* 80 *);
  39.  
  40.  
  41.  TYPE
  42.      VERSION    = ARRAY [1..35] OF CHAR;
  43.     tstring = ARRAY [1..maxstr] OF CHAR;
  44.     point    = POINTER TO lines;
  45.     lines    = RECORD
  46.             Tag,Monat : SHORTCARD;
  47.             Jahr      : CARDINAL;
  48.             Text      : tstring;
  49.             last      : point;
  50.             next      : point;
  51.           END;
  52.  
  53.  
  54.  VAR
  55.     Version                    := VERSION{"$VER: Kalender 2.1 (18.12.1993)"};
  56.     Wochentag,Tag,Monat,OTag,OMonat,t,m    : SHORTCARD;
  57.     Jahr,OJahr,j                : CARDINAL;
  58.     ZeitRaum                : CARDINAL;
  59.     language                : SHORTCARD;
  60.     already,mark,nodata            : BOOLEAN;
  61.     saveflag,save                : BOOLEAN;
  62.     filename,path,argstr,arg,file        : tstring;
  63.     wurzel,stat                : point;
  64.     window2                    : SHORTCARD;
  65.     x,y                    : SHORTCARD;
  66.     set                    : LONGSET;
  67.     cptr                    : strptr;
  68.     cquot,err,sign                : BOOLEAN;
  69.     zr                    : LONGINT;
  70.     i                    : INTEGER;
  71.     date1,date2,state,line            : tstring;
  72.     slen                    : SHORTCARD;
  73.     port                    : MsgPortPtr;
  74.  
  75.  
  76.  PROCEDURE delete(VAR wurzel,zeiger : point);
  77.  
  78.  BEGIN
  79.    IF (wurzel # NIL) AND (zeiger # NIL) THEN
  80.      IF zeiger = wurzel THEN
  81.        wurzel := zeiger^.next;
  82.        wurzel^.last := NIL;
  83.        DEALLOCATE(zeiger,SIZE(lines));
  84.      ELSE
  85.        IF zeiger^.next # NIL THEN
  86.          zeiger^.next^.last := zeiger^.last;
  87.        END;
  88.        zeiger^.last^.next := zeiger^.next;
  89.        DEALLOCATE(zeiger,SIZE(lines));
  90.      END;
  91.      zeiger := NIL;
  92.    END;
  93.  END delete;
  94.  
  95.  
  96.  PROCEDURE insert(VAR wurzel : point; Tag,Monat : SHORTCARD;
  97.                     Jahr : CARDINAL; Text : tstring);
  98.  
  99.  VAR
  100.     new,zeiger    : point;
  101.  
  102.  BEGIN
  103.    ALLOCATE(new,SIZE(lines));
  104.    new^.Tag   := Tag;
  105.    new^.Monat := Monat;
  106.    new^.Jahr  := Jahr;
  107.    new^.Text  := Text;
  108.    new^.last  := NIL;
  109.    new^.next  := NIL;
  110.    IF wurzel = NIL THEN
  111.      wurzel := new;
  112.    ELSIF (wurzel^.Monat > Monat) OR ((wurzel^.Monat = Monat) AND (wurzel^.Tag > Tag)) THEN
  113.      new^.next := wurzel;
  114.      wurzel^.last := new;
  115.      wurzel := new;
  116.    ELSE
  117.      zeiger := wurzel;
  118.      WHILE (zeiger # NIL) AND (zeiger^.Monat < Monat) DO
  119.        IF zeiger^.next = NIL THEN
  120.          zeiger^.next := new;
  121.          new^.last := zeiger;
  122.          RETURN;
  123.        END;
  124.        zeiger := zeiger^.next;
  125.      END;
  126.  
  127.      IF zeiger^.Monat = Monat THEN
  128.        WHILE (zeiger # NIL) AND (zeiger^.Tag <= Tag) DO
  129.          IF zeiger^.next = NIL THEN
  130.            zeiger^.next := new;
  131.            new^.last := zeiger;
  132.            RETURN;
  133.          ELSIF (zeiger^.next # NIL) AND (zeiger^.next^.Monat > Monat) THEN
  134.            new^.next := zeiger^.next;
  135.            new^.last := zeiger;
  136.            zeiger^.next^.last := new;
  137.            zeiger^.next := new;
  138.            RETURN;
  139.      END;
  140.          zeiger := zeiger^.next;
  141.        END;
  142.      END;
  143.  
  144.      new^.next := zeiger;
  145.      new^.last := zeiger^.last;
  146.      zeiger^.last := new;
  147.      new^.last^.next := new;
  148.    END;
  149.  END insert;
  150.  
  151.  
  152.  PROCEDURE konvdate(VAR Tag,Monat : SHORTCARD; VAR Jahr : CARDINAL; VAR txt : ARRAY OF CHAR);
  153.  
  154.  VAR
  155.     i : SHORTCARD;
  156.  
  157.  BEGIN
  158.    i := 0;
  159.    Tag := SHORTCARD(txt[i])-48;
  160.    INC(i);
  161.    IF txt[i] # "." THEN
  162.      Tag := Tag*10+(SHORTCARD(txt[i])-48);
  163.      INC(i);
  164.    END;
  165.    INC(i);
  166.    Monat := SHORTCARD(txt[i])-48;
  167.    INC(i);
  168.    IF txt[i] # "." THEN
  169.      Monat := Monat*10+SHORTCARD(txt[i])-48;
  170.      INC(i);
  171.    END;
  172.    INC(i);
  173.    WHILE txt[i] = " " DO
  174.      INC(i);
  175.    END;
  176.    Jahr := 0;
  177.    IF txt[i] # ":" THEN
  178.      Jahr := CARDINAL(txt[i])-48;
  179.      INC(i);
  180.      Jahr := Jahr*10+CARDINAL(txt[i])-48;
  181.      INC(i);
  182.      IF txt[i] # " " THEN
  183.        Jahr := Jahr*10+CARDINAL(txt[i])-48;
  184.        INC(i);
  185.        Jahr := Jahr*10+CARDINAL(txt[i])-48;
  186.        INC(i);
  187.      END;
  188.      WHILE txt[i] = " " DO
  189.        INC(i);
  190.      END;
  191.    END;
  192.    INC(i);
  193.    WHILE txt[i] = " " DO
  194.      INC(i);
  195.    END;
  196.    Delete(txt,0,i);
  197.  END konvdate;
  198.  
  199.  
  200.  PROCEDURE ReadDaten(VAR wurzel : point; filename : tstring) : BOOLEAN;
  201.  
  202.    PROCEDURE ReadLines(VAR wurzel : point; VAR Daten : File);
  203.  
  204.    VAR
  205.     data            : CHAR;
  206.     daten            : tstring;
  207.     i            : SHORTCARD;
  208.     Tag,Monat        : SHORTCARD;
  209.     Jahr            : CARDINAL;
  210.  
  211.    BEGIN
  212.      REPEAT
  213.        ReadChar(Daten,data);
  214.        WHILE (NOT Daten.eof) AND ((CARDINAL(data) = 10) OR (data = " ")) DO
  215.          ReadChar(Daten,data)
  216.        END;
  217.        IF NOT Daten.eof THEN
  218.          i := 1;
  219.          WHILE (CARDINAL(data) # 10) AND (i<maxstr) DO
  220.            daten[i] := data;
  221.            INC(i);
  222.            ReadChar(Daten,data);
  223.          END;
  224.          IF CARDINAL(data) # 10 THEN
  225.            REPEAT
  226.              ReadChar(Daten,data);
  227.            UNTIL CARDINAL(data) = 10;
  228.          END;
  229.          daten[i] := CHAR(0);
  230.          konvdate(Tag,Monat,Jahr,daten);
  231.          insert(wurzel,Tag,Monat,Jahr,daten);
  232.        END;
  233.      UNTIL Daten.eof OR (Daten.res # done);
  234.    END ReadLines;
  235.  
  236.  VAR
  237.     Daten    : File;
  238.     ok    : BOOLEAN;
  239.  
  240.  BEGIN
  241.    Lookup(Daten,filename,1024,FALSE);
  242.    IF Daten.res = done THEN
  243.      ok := TRUE;
  244.      ReadLines(wurzel,Daten);
  245.    ELSE
  246.      ok := FALSE;
  247.    END;
  248.    Close(Daten);
  249.    RETURN(ok);
  250.  END ReadDaten;
  251.  
  252.  
  253.  PROCEDURE format(z : CARDINAL; VAR c : ARRAY OF CHAR; l : SHORTCARD);
  254.  
  255.  VAR
  256.     i : SHORTCARD;
  257.  
  258.  BEGIN
  259.    IF (z > 0) OR (l > 0) THEN
  260.      FOR i := HIGH(c) TO 1 BY -1 DO
  261.        c[i] := c[i-1];
  262.      END;
  263.      c[0] := CHAR((z MOD 10)+48);
  264.      format(z DIV 10,c,l-1);
  265.    END;
  266.  END format;
  267.  
  268.  
  269.  PROCEDURE WriteDaten(wurzel : point; filename : tstring);
  270.  
  271.  VAR
  272.     Daten : File;
  273.  
  274.    PROCEDURE WriteLines(zeiger : point; VAR Daten : File);
  275.  
  276.      PROCEDURE WriteLine(zeiger : point; VAR Daten : File);
  277.  
  278.      VAR
  279.     data    : ARRAY [1..5] OF CHAR;
  280.     i    : SHORTCARD;
  281.  
  282.      BEGIN
  283.        data := "";
  284.        format(zeiger^.Tag,data,2);
  285.        i := 1;
  286.        WHILE data[i] > CHAR(0) DO
  287.          WriteChar(Daten,data[i]);
  288.          INC(i);
  289.        END;
  290.        WriteChar(Daten,".");
  291.        data := "";
  292.        format(zeiger^.Monat,data,2);
  293.        i := 1;
  294.        WHILE data[i] > CHAR(0) DO
  295.          WriteChar(Daten,data[i]);
  296.          INC(i);
  297.        END;
  298.        WriteChar(Daten,".");
  299.        IF zeiger^.Jahr > 0 THEN
  300.          data := "";
  301.          format(zeiger^.Jahr,data,4);
  302.          i := 1;
  303.          WHILE data[i] > CHAR(0) DO
  304.            WriteChar(Daten,data[i]);
  305.            INC(i);
  306.          END;
  307.        ELSE
  308.          WriteChar(Daten," ");
  309.          WriteChar(Daten," ");
  310.          WriteChar(Daten," ");
  311.          WriteChar(Daten," ");
  312.        END;
  313.        WriteChar(Daten," ");
  314.        WriteChar(Daten,":");
  315.        WriteChar(Daten," ");
  316.        i := 1;
  317.        WHILE zeiger^.Text[i] > CHAR(0) DO
  318.          WriteChar(Daten,zeiger^.Text[i]);
  319.          INC(i);
  320.        END;
  321.        WriteChar(Daten,CHAR(10));
  322.      END WriteLine;
  323.  
  324.    BEGIN
  325.      WHILE zeiger # NIL DO
  326.        WriteLine(zeiger,Daten);
  327.        zeiger := zeiger^.next;
  328.      END;
  329.    END WriteLines;
  330.  
  331.  BEGIN
  332.    Lookup(Daten,filename,1024,TRUE);
  333.    IF Daten.res = done THEN
  334.      WriteLines(wurzel,Daten);
  335.    END;
  336.    Close(Daten);
  337.  END WriteDaten;
  338.  
  339.  
  340.  PROCEDURE search(zeiger : point; Tag,Monat : SHORTCARD) : point;
  341.  
  342.  BEGIN
  343.    WHILE zeiger # NIL DO
  344.      IF zeiger^.Monat > Monat THEN
  345.        RETURN(zeiger);
  346.      ELSIF zeiger^.Monat = Monat THEN
  347.        IF zeiger^.Tag >= Tag THEN
  348.          RETURN(