home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / util / misc / kalender / txt / kalender.mod < prev    next >
Text File  |  1994-01-15  |  25KB  |  945 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.  FROM LocaleL        IMPORT    localeBase;
  36.  
  37.  
  38.  CONST
  39.     maxstr    = 173 (* 80 *);
  40.  
  41.  
  42.  TYPE
  43.      VERSION    = ARRAY [1..35] OF CHAR;
  44.     tstring = ARRAY [1..maxstr] OF CHAR;
  45.     point    = POINTER TO lines;
  46.     lines    = RECORD
  47.             Tag,Monat : SHORTCARD;
  48.             Jahr      : CARDINAL;
  49.             Text      : tstring;
  50.             last      : point;
  51.             next      : point;
  52.           END;
  53.  
  54.  
  55.  VAR
  56.     Version                    := VERSION{"$VER: Kalender 2.2 (15.01.1994)"};
  57.     Wochentag,Tag,Monat,OTag,OMonat,t,m    : SHORTCARD;
  58.     Jahr,OJahr,j                : CARDINAL;
  59.     ZeitRaum                : CARDINAL;
  60.     language                : SHORTCARD;
  61.     already,mark,nodata            : BOOLEAN;
  62.     saveflag,save                : BOOLEAN;
  63.     filename,path,argstr,arg,file        : tstring;
  64.     wurzel,stat                : point;
  65.     window2                    : SHORTCARD;
  66.     x,y                    : SHORTCARD;
  67.     set                    : LONGSET;
  68.     cptr                    : strptr;
  69.     cquot,err,sign                : BOOLEAN;
  70.     zr                    : LONGINT;
  71.     i                    : INTEGER;
  72.     date1,date2,state,line            : tstring;
  73.     slen                    : SHORTCARD;
  74.     port                    : MsgPortPtr;
  75.  
  76.  
  77.  PROCEDURE delete(VAR wurzel,zeiger : point);
  78.  
  79.  BEGIN
  80.    IF (wurzel # NIL) AND (zeiger # NIL) THEN
  81.      IF zeiger = wurzel THEN
  82.        wurzel := zeiger^.next;
  83.        wurzel^.last := NIL;
  84.        DEALLOCATE(zeiger,SIZE(lines));
  85.      ELSE
  86.        IF zeiger^.next # NIL THEN
  87.          zeiger^.next^.last := zeiger^.last;
  88.        END;
  89.        zeiger^.last^.next := zeiger^.next;
  90.        DEALLOCATE(zeiger,SIZE(lines));
  91.      END;
  92.      zeiger := NIL;
  93.    END;
  94.  END delete;
  95.  
  96.  
  97.  PROCEDURE insert(VAR wurzel : point; Tag,Monat : SHORTCARD;
  98.                     Jahr : CARDINAL; Text : tstring);
  99.  
  100.  VAR
  101.     new,zeiger    : point;
  102.  
  103.  BEGIN
  104.    ALLOCATE(new,SIZE(lines));
  105.    new^.Tag   := Tag;
  106.    new^.Monat := Monat;
  107.    new^.Jahr  := Jahr;
  108.    new^.Text  := Text;
  109.    new^.last  := NIL;
  110.    new^.next  := NIL;
  111.    IF wurzel = NIL THEN
  112.      wurzel := new;
  113.    ELSIF (wurzel^.Monat > Monat) OR ((wurzel^.Monat = Monat) AND (wurzel^.Tag > Tag)) THEN
  114.      new^.next := wurzel;
  115.      wurzel^.last := new;
  116.      wurzel := new;
  117.    ELSE
  118.      zeiger := wurzel;
  119.      WHILE (zeiger # NIL) AND (zeiger^.Monat < Monat) DO
  120.        IF zeiger^.next = NIL THEN
  121.          zeiger^.next := new;
  122.          new^.last := zeiger;
  123.          RETURN;
  124.        END;
  125.        zeiger := zeiger^.next;
  126.      END;
  127.  
  128.      IF zeiger^.Monat = Monat THEN
  129.        WHILE (zeiger # NIL) AND (zeiger^.Tag <= Tag) DO
  130.          IF zeiger^.next = NIL THEN
  131.            zeiger^.next := new;
  132.            new^.last := zeiger;
  133.            RETURN;
  134.          ELSIF (zeiger^.next # NIL) AND (zeiger^.next^.Monat > Monat) THEN
  135.            new^.next := zeiger^.next;
  136.            new^.last := zeiger;
  137.            zeiger^.next^.last := new;
  138.            zeiger^.next := new;
  139.            RETURN;
  140.      END;
  141.          zeiger := zeiger^.next;
  142.        END;
  143.      END;
  144.  
  145.      new^.next := zeiger;
  146.      new^.last := zeiger^.last;
  147.      zeiger^.last := new;
  148.      new^.last^.next := new;
  149.    END;
  150.  END insert;
  151.  
  152.  
  153.  PROCEDURE konvdate(VAR Tag,Monat : SHORTCARD; VAR Jahr : CARDINAL; VAR txt : ARRAY OF CHAR);
  154.  
  155.  VAR
  156.     i : SHORTCARD;
  157.  
  158.  BEGIN
  159.    i := 0;
  160.    Tag := SHORTCARD(txt[i])-48;
  161.    INC(i);
  162.    IF txt[i] # "." THEN
  163.      Tag := Tag*10+(SHORTCARD(txt[i])-48);
  164.      INC(i);
  165.    END;
  166.    INC(i);
  167.    Monat := SHORTCARD(txt[i])-48;
  168.    INC(i);
  169.    IF txt[i] # "." THEN
  170.      Monat := Monat*10+SHORTCARD(txt[i])-48;
  171.      INC(i);
  172.    END;
  173.    INC(i);
  174.    WHILE txt[i] = " " DO
  175.      INC(i);
  176.    END;
  177.    Jahr := 0;
  178.    IF txt[i] # ":" THEN
  179.      Jahr := CARDINAL(txt[i])-48;
  180.      INC(i);
  181.      Jahr := Jahr*10+CARDINAL(txt[i])-48;
  182.      INC(i);
  183.      IF txt[i] # " " THEN
  184.        Jahr := Jahr*10+CARDINAL(txt[i])-48;
  185.        INC(i);
  186.        Jahr := Jahr*10+CARDINAL(txt[i])-48;
  187.        INC(i);
  188.      END;
  189.      WHILE txt[i] = " " DO
  190.        INC(i);
  191.      END;
  192.    END;
  193.    INC(i);
  194.    WHILE txt[i] = " " DO
  195.      INC(i);
  196.    END;
  197.    Delete(txt,0,i);
  198.  END konvdate;
  199.  
  200.  
  201.  PROCEDURE ReadDaten(VAR wurzel : point; filename : tstring) : BOOLEAN;
  202.  
  203.    PROCEDURE ReadLines(VAR wurzel : point; VAR Daten : File);
  204.  
  205.    VAR
  206.     data            : CHAR;
  207.     daten            : tstring;
  208.     i            : SHORTCARD;
  209.     Tag,Monat        : SHORTCARD;
  210.     Jahr            : CARDINAL;
  211.  
  212.    BEGIN
  213.      REPEAT
  214.        ReadChar(Daten,data);
  215.        WHILE (NOT Daten.eof) AND ((CARDINAL(data) = 10) OR (data = " ")) DO
  216.          ReadChar(Daten,data)
  217.        END;
  218.        IF NOT Daten.eof THEN
  219.          i := 1;
  220.          WHILE (CARDINAL(data) # 10) AND (i<maxstr) DO
  221.            daten[i] := data;
  222.            INC(i);
  223.            ReadChar(Daten,data);
  224.          END;
  225.          IF CARDINAL(data) # 10 THEN
  226.            REPEAT
  227.              ReadChar(Daten,data);
  228.            UNTIL CARDINAL(data) = 10;
  229.          END;
  230.          daten[i] := CHAR(0);
  231.          konvdate(Tag,Monat,Jahr,daten);
  232.          insert(wurzel,Tag,Monat,Jahr,daten);
  233.        END;
  234.      UNTIL Daten.eof OR (Daten.res # done);
  235.    END ReadLines;
  236.  
  237.  VAR
  238.     Daten    : File;
  239.     ok    : BOOLEAN;
  240.  
  241.  BEGIN
  242.    Lookup(Daten,filename,1024,FALSE);
  243.    IF Daten.res = done THEN
  244.      ok := TRUE;
  245.      ReadLines(wurzel,Daten);
  246.    ELSE
  247.      ok := FALSE;
  248.    END;
  249.    Close(Daten);
  250.    RETURN(ok);
  251.  END ReadDaten;
  252.  
  253.  
  254.  PROCEDURE format(z : CARDINAL; VAR c : ARRAY OF CHAR; l : SHORTCARD);
  255.  
  256.  VAR
  257.     i : SHORTCARD;
  258.  
  259.  BEGIN
  260.    IF (z > 0) OR (l > 0) THEN
  261.      FOR i := HIGH(c) TO 1 BY -1 DO
  262.        c[i] := c[i-1];
  263.      END;
  264.      c[0] := CHAR((z MOD 10)+48);
  265.      format(z DIV 10,c,l-1);
  266.    END;
  267.  END format;
  268.  
  269.  
  270.  PROCEDURE WriteDaten(wurzel : point; filename : tstring);
  271.  
  272.  VAR
  273.     Daten : File;
  274.  
  275.    PROCEDURE WriteLines(zeiger : point; VAR Daten : File);
  276.  
  277.      PROCEDURE WriteLine(zeiger : point; VAR Daten : File);
  278.  
  279.      VAR
  280.     data    : ARRAY [1..5] OF CHAR;
  281.     i    : SHORTCARD;
  282.  
  283.      BEGIN
  284.        data := "";
  285.        format(zeiger^.Tag,data,2);
  286.        i := 1;
  287.        WHILE data[i] > CHAR(0) DO
  288.          WriteChar(Daten,data[i]);
  289.          INC(i);
  290.        END;
  291.        WriteChar(Daten,".");
  292.        data := "";
  293.        format(zeiger^.Monat,data,2);
  294.        i := 1;
  295.        WHILE data[i] > CHAR(0) DO
  296.          WriteChar(Daten,data[i]);
  297.          INC(i);
  298.        END;
  299.        WriteChar(Daten,".");
  300.        IF zeiger^.Jahr > 0 THEN
  301.          data := "";
  302.          format(zeiger^.Jahr,data,4);
  303.          i := 1;
  304.          WHILE data[i] > CHAR(0) DO
  305.            WriteChar(Daten,data[i]);
  306.            INC(i);
  307.          END;
  308.        ELSE
  309.          WriteChar(Daten," ");
  310.          WriteChar(Daten," ");
  311.          WriteChar(Daten," ");
  312.          WriteChar(Daten," ");
  313.        END;
  314.        WriteChar(Daten," ");
  315.        WriteChar(Daten,":");
  316.        WriteChar(Daten," ");
  317.        i := 1;
  318.        WHILE zeiger^.Text[i] > CHAR(0) DO
  319.          WriteChar(Daten,zeiger^.Text[i]);
  320.          INC(i);
  321.        END;
  322.        WriteChar(Daten,CHAR(10));
  323.      END WriteLine;
  324.  
  325.    BEGIN
  326.      WHILE zeiger # NIL DO
  327.        WriteLine(zeiger,Daten);
  328.        zeiger := zeiger^.next;
  329.      END;
  330.    END WriteLines;
  331.  
  332.  BEGIN
  333.    Lookup(Daten,filename,1024,TRUE);
  334.    IF Daten.res = done THEN
  335.      WriteLines(wurzel,Daten);
  336.    END;
  337.    Close(Daten);
  338.  END WriteDaten;
  339.  
  340.  
  341.  PROCEDURE search(zeiger : point; Tag,Monat : SHORTCARD) : point;
  342.  
  343.  BEGIN
  344.    WHILE zeiger # NIL DO
  345.      IF zeiger^.Monat > Monat THEN
  346.        RETURN(zeiger);
  347.      ELSIF zeiger^.Monat = Monat THEN
  348.        IF zeiger^.Tag >= Tag THEN
  349.          RETURN(zeiger);
  350.        END;
  351.      END;
  352.      zeiger := zeiger^.next;
  353.    END;
  354.    RETURN(NIL);
  355.  END search;
  356.  
  357.  
  358.  PROCEDURE searchStatus(Line : point) : point;
  359.  
  360.  BEGIN
  361.    Line := search(Line,0,0);
  362.    RETURN(Line);
  363.  END searchStatus;
  364.  
  365.  
  366.  PROCEDURE specialtext(VAR str : ARRAY OF CHAR; Tag,Monat : SHORTCARD; Jahr : CARDINAL; jahr : CARDINAL; insertstr : ARRAY OF CHAR) : SHORTCARD;
  367.  
  368.  VAR i            : INTEGER;
  369.      istr        : tstring;
  370.      err        : BOOLEAN;
  371.      wt            : wtstring;
  372.      del        : SHORTCARD;
  373.      dcount,count    : SHORTCARD;
  374.      wlen        : SHORTCARD;
  375.  
  376.    PROCEDURE insl(VAR wt : wtstring; wlen : SHORTCARD);
  377.  
  378.    VAR
  379.     len : SHORTCARD;
  380.  
  381.    BEGIN
  382.      len := SHORTCARD(Length(wt));
  383.      WHILE len < wlen DO
  384.        wt[len+1] := ' ';
  385.        wt[len+2] := CHAR(0);
  386.        INC(len);
  387.      END;
  388.    END insl;
  389.  
  390.  BEGIN
  391.     count := 0;
  392.     i := Occurs(str,first,"%",FALSE);
  393.     WHILE i # last DO
  394.       istr := "";
  395.       del := 2;
  396.       CASE str[i+1] OF
  397.         "d" : ValToStr(Tag,FALSE,istr,10,2,"0",err);
  398.           Insert(str,i+2,istr);|
  399.         "m" : ValToStr(Monat,FALSE,istr,10,2,"0",err);
  400.           Insert(str,i+2,istr);|
  401.     "o" : wlen := monat(Monat,wt,language);
  402.           IF str[i+2] = 'l' THEN
  403.             insl(wt,wlen);
  404.             del := 3;
  405.           END;
  406.               Insert(str,i+INTEGER(del),wt);|
  407.         "y" : ValToStr(Jahr,FALSE,istr,10,4,"0",err);
  408.           Insert(str,i+2,istr);|
  409.         "w" : wlen := wochentag(Weekday(Tag,Monat,jahr),wt,language);
  410.           IF str[i+2] = 'l' THEN
  411.             insl(wt,wlen);
  412.             del := 3;
  413.           END;
  414.           Insert(str,i+INTEGER(del),wt);|
  415.         "n" : ValToStr(Weekday(Tag,Monat,jahr),FALSE,istr,10,1,"0",err);
  416.           Insert(str,i+2,istr);|
  417.         "e" : ValToStr(GetWeek(Tag,Monat,jahr),FALSE,istr,10,2,"0",err);
  418.           Insert(str,i+2,istr);|
  419.     "t" : Insert(str,i+2,insertstr);|
  420.         "0" : (* use locale.library *) |
  421.     "1" : Insert(str,i+2,date1);|
  422.     "2" : Insert(str,i+2,date2);
  423.       ELSE
  424.         del := 0;
  425.         INC(dcount);
  426.       END;
  427.       Delete(str,i,del);
  428.       i := Occurs(str,first,"%",FALSE);
  429.       count := dcount;
  430.       WHILE count > 0 DO
  431.         i := Occurs(str,i+1,"%",FALSE);
  432.         DEC(count);
  433.       END;
  434.     END;
  435.     RETURN(Length(str));
  436.  END specialtext;
  437.  
  438.  
  439.  PROCEDURE GetNumberOf(zeiger : point; Tag,Monat : SHORTCARD; VAR maxx : SHORTCARD) : SHORTCARD;
  440.  
  441.  VAR
  442.     anz            : CARDINAL;
  443.     len            : CARDINAL;
  444.     txt            : tstring;
  445.  
  446.  BEGIN
  447.    anz := 0;
  448.    zeiger := search(zeiger,Tag,Monat);
  449.    WHILE zeiger # NIL DO
  450.      IF (zeiger^.Monat = Monat) AND (zeiger^.Tag = Tag) THEN
  451.        IF (Occurs(zeiger^.Text,first,"%k",FALSE) # last) AND (zeiger^.Jahr > 0) THEN
  452.          IF (zeiger^.Jahr < Jahr) OR ((zeiger^.Jahr = Jahr) AND (zeiger^.Monat < Monat)) OR ((zeiger^.Jahr = Jahr) AND (zeiger^.Monat =Monat) AND (zeiger^.Tag < Tag)) THEN
  453.            delete(wurzel,zeiger);
  454.            saveflag := TRUE;
  455.          ELSE
  456.            INC(anz);
  457.            Copy(txt,line);
  458.            len := specialtext(txt,Tag,Monat,Jahr,Jahr,zeiger^.Text);
  459.          END;
  460.        ELSE
  461.          INC(anz);
  462.          Copy(txt,line);
  463.          len := specialtext(txt,Tag,Monat,Jahr,Jahr,zeiger^.Text);
  464.        END;
  465.        IF len > maxx THEN
  466.          maxx := len;
  467.        END;
  468.        zeiger := zeiger^.next;
  469.      ELSIF (zeiger^.Monat = Monat) AND (zeiger^.Tag < Tag) THEN
  470.        zeiger := zeiger^.next;
  471.      ELSIF (zeiger^.Monat > Monat) OR
  472.             ((zeiger^.Monat = Monat) AND (zeiger^.Tag > Tag)) THEN
  473.        zeiger := NIL;
  474.      END;
  475.    END;
  476.    RETURN(anz);
  477.  END GetNumberOf;
  478.  
  479.  
  480.  PROCEDURE GetOutDays(zeiger : point; Tag,Monat : SHORTCARD; Jahr : CARDINAL;
  481.                     ZeitRaum : CARDINAL; VAR x : SHORTCARD) : SHORTCARD;
  482.  
  483.  VAR
  484.     days    : CARDINAL;
  485.     anz    : SHORTCARD;
  486.  
  487.  BEGIN
  488.    anz := 0;
  489.    days := 0;
  490.    zeiger := search(zeiger,Tag,Monat);
  491.    WHILE days < ZeitRaum DO
  492.      anz := anz + GetNumberOf(zeiger,Tag,Monat,x);
  493.      INC(Tag);
  494.      IF Tag > maxDays(Monat,Jahr) THEN
  495.        Tag := 1;
  496.        INC(Monat);
  497.        IF Monat > 12 THEN
  498.          Monat := 1;
  499.          INC(Jahr);
  500.          zeiger := wurzel;
  501.        END;
  502.      END;
  503.      INC(days);
  504.    END;
  505.    RETURN(anz);
  506.  END GetOutDays;
  507.  
  508.  
  509.  PROCEDURE formattext(VAR zeiger : point; VAR text : tstring; Tag,Monat : SHORTCARD;
  510.                 Jahr : CARDINAL; VAR saveflag : BOOLEAN) : BOOLEAN;
  511.  
  512.  VAR
  513.     i,j    : INTEGER;
  514.     str    : ARRAY [1..2] OF CHAR;
  515.     err,ofl    : BOOLEAN;
  516.     len    : SHORTCARD;
  517.     tx    : tstring;
  518.  
  519.  BEGIN
  520.    ofl := TRUE;
  521.    Copy(text,line);
  522.    IF zeiger^.Jahr > 0 THEN
  523.      len := specialtext(text,zeiger^.Tag,zeiger^.Monat,zeiger^.Jahr,Jahr,zeiger^.Text);
  524.    ELSE
  525.      len := specialtext(text,zeiger^.Tag,zeiger^.Monat,Jahr,Jahr,zeiger^.Text);
  526.    END;
  527.    i := Occurs(text,first,"%",TRUE);
  528.    IF i # last THEN
  529.      CASE text[i+2] OF
  530.        "j" : str := "";
  531.              IF zeiger^.Jahr > 0 THEN
  532.                j := Jahr-zeiger^.Jahr;
  533.                ValToStr(j,FALSE,str,10,2," ",err);
  534.              END;
  535.              Insert(text,i+2,str); |
  536.        "k" : IF tagdiff(zeiger^.Tag,zeiger^.Monat,0,Tag,Monat,0) = 0 THEN
  537.            saveflag := TRUE;
  538.              END; |
  539.        "h" : IF tagdiff(zeiger^.Tag,zeiger^.Monat,0,Tag,Monat,0) # 0 THEN
  540.                ofl := FALSE;
  541.              END; |
  542.        "'" : j := Occurs(text,i+3,"'",TRUE);
  543.          IF j # last THEN
  544.            CopyPart(tx,text,i+2,j-(i+2));
  545.            Delete(text,i+2,j-(i+1));
  546.            IF tagdiff(zeiger^.Tag,zeiger^.Monat,0,Tag,Monat,0) = 0 THEN
  547.              IF ~SendRexxMsg(port,"REXX",tx) THEN
  548.                Concat(text," (ERROR!)");
  549.              END;
  550.            END;
  551.          END;
  552.      ELSE
  553.      END;
  554.      Delete(text,i,2);
  555.    END;
  556.    RETURN(ofl);
  557.  END formattext;
  558.  
  559.  
  560.  PROCEDURE OutDays(zeiger : point; Tag,Monat : SHORTCARD; Jahr : CARDINAL;
  561.                     ZeitRaum : CARDINAL; mark : BOOLEAN);
  562.  
  563.  VAR
  564.     anz    : SHORTCARD;
  565.     x    : SHORTCARD;
  566.  
  567.    PROCEDURE textoutput(VAR zeiger : point; Tag,Monat : SHORTCARD;
  568.         Jahr : CARDINAL; VAR saveflag : BOOLEAN; mark : BOOLEAN);
  569.  
  570.    VAR
  571.     ptr    : point;
  572.     text    : tstring;
  573.     sf    : BOOLEAN;
  574.  
  575.    BEGIN
  576.      sf := FALSE;
  577.      IF formattext(zeiger,text,Tag,Monat,Jahr,sf) THEN
  578.        IF mark AND (tagdiff(Tag,Monat,0,zeiger^.Tag,zeiger^.Monat,0) = 0) THEN
  579.          IF sf THEN
  580.            WriteString(revc1);
  581.            saveflag := TRUE;
  582.            ptr := zeiger;
  583.            zeiger := zeiger^.last;
  584.            delete(wurzel,ptr);
  585.          ELSE
  586.            WriteString(normc1);
  587.          END;
  588.        ELSIF mark AND (tagdiff(Tag,Monat,0,zeiger^.Tag,zeiger^.Monat,0) = 1) THEN
  589.          WriteString(normc2);
  590.        END;
  591.        WriteString(text); WriteString(normal); WriteLn;
  592.      END;
  593.    END textoutput;
  594.  
  595.    PROCEDURE windowoutput(VAR zeiger : point; Tag,Monat : SHORTCARD;
  596.         Jahr : CARDINAL; VAR saveflag : BOOLEAN; mark : BOOLEAN);
  597.  
  598.    VAR
  599.     ptr    : point;
  600.     text    : tstring;
  601.     sf    : BOOLEAN;
  602.     col    : SHORTCARD;
  603.     rev    : BOOLEAN;
  604.  
  605.    BEGIN
  606.      rev := FALSE;
  607.      col := 1;
  608.      IF mark AND (tagdiff(zeiger^.Tag,zeiger^.Monat,0,Tag,Monat,0) = 0) THEN
  609.        col := 2;
  610.      ELSIF mark AND (tagdiff(Tag,Monat,0,zeiger^.Tag,zeiger^.Monat,0) = 1) THEN
  611.        col := 3;
  612.      END;
  613.      sf := FALSE;
  614.      IF formattext(zeiger,text,Tag,Monat,Jahr,sf) THEN
  615.        IF sf THEN
  616.          rev := TRUE;
  617.          saveflag := TRUE;
  618.          ptr := zeiger;
  619.          zeiger := zeiger^.last;
  620.          delete(wurzel,ptr);
  621.        END;
  622.        OutputWin2(text,col,rev);
  623.      END;
  624.    END windowoutput;
  625.  
  626.  BEGIN
  627.    zeiger := search(zeiger,Tag,Monat);
  628.    anz := GetOutDays(zeiger,Tag,Monat,Jahr,ZeitRaum,x);
  629.    IF anz > 0 THEN
  630.      IF ~wbStarted AND (slen > 0) THEN
  631.        WriteString(state); WriteLn;
  632.        WriteLn;
  633.      END;
  634.    END;
  635.    WHILE anz > 0 DO
  636.      IF wbStarted THEN
  637.        windowoutput(zeiger,Tag,Monat,Jahr,saveflag,mark);
  638.      ELSE
  639.        textoutput(zeiger,Tag,Monat,Jahr,saveflag,mark);
  640.      END;
  641.      IF zeiger = NIL THEN
  642.        zeiger := wurzel;
  643.        zeiger := search(zeiger,1,1);
  644.        INC(Jahr);
  645.      END;
  646.      zeiger := zeiger^.next;
  647.      IF zeiger = NIL THEN
  648.        zeiger := wurzel;
  649.        zeiger := search(zeiger,1,1);
  650.        INC(Jahr);
  651.      END;
  652.      DEC(anz);
  653.    END;
  654.  END OutDays;
  655.  
  656.  BEGIN
  657.    IF Version[0] # CHAR(0) THEN
  658.    END;
  659.    (* Init *)
  660.    wurzel   := NIL;
  661.    (* Setups *)
  662.    path     := "s:";
  663.    filename := "Kalender.dat";
  664.    language := 2;
  665.    saveflag := FALSE;
  666.    save := TRUE;
  667.    ZeitRaum := 31;
  668.    already := FALSE;
  669.    mark := FALSE;
  670.    nodata := FALSE;
  671.    date1 := "%d.%m.";
  672.    date2 := "%d.%m.%y";
  673.    line := "%1 : %t";
  674.    state := "Terminübersicht am %w, den %d.%m.%y";
  675.    port := OpenRexxPort();
  676.    (* get options *)
  677.    IF ~wbStarted AND CheckOption("?") THEN
  678.      WriteString("HELP/S,PATH/K,FILE/K,SHOW/N/K,LANGUAGE/N/K,ONCE/S,MARK/T,INSERT ''d.m.[y] : text''/K/F,STATUS ''...''/K,DATE1 ''%d.%m.%y''/K,DATE2 ''%d.%m.''/K,LINE ''%1 : %t''/K,NOSAVE/S,NODATA/S"); WriteLn;
  679.      Terminate;
  680.    END;
  681.    IF ~wbStarted AND CheckOption("HELP") THEN
  682.      WriteString("Kalender version 2.1, Copyright (C) 1993 Kai Hofmann"); WriteLn;
  683.      WriteString("Kalender comes with ABSOLUTELY NO WARRANTY; for details see the 'COPYING'-file"); WriteLn;
  684.      WriteString("This is free software, and you are welcome to redistribute it"); WriteLn;
  685.      WriteString("under certain conditions; see 'COPYING'-file for details."); WriteLn;
  686.      WriteLn;
  687.      WriteString("for detail HELP see Kalender.doc file!"); WriteLn;
  688.      WriteString("or contact me (only email - sorry!): i07m@alf.zfn.uni-bremen.de"); WriteLn;
  689.      Terminate;
  690.    END;
  691.    IF CheckOption("PATH") THEN
  692.      cptr := GetOptionParam("PATH",cquot);
  693.      IF cptr # NIL THEN
  694.        Copy(path,cptr^);
  695.        Killstr(cptr);
  696.      END;
  697.    END;
  698.    Assert(((path[Length(path)] = '/') OR (path[Length(path)] = ":") OR (Length(path) = 0)),ADR("Wrong path!"));
  699.    IF CheckOption("FILE") THEN
  700.      cptr := GetOptionParam("FILE",cquot);
  701.      IF cptr # NIL THEN
  702.        Copy(filename,cptr^);
  703.        Killstr(cptr);
  704.      END;
  705.    END;
  706.    Assert(Length(filename) # 0,ADR("Wrong filename!"));
  707.  
  708.    Copy(file,filename);
  709.    (* Read data *)
  710.    Insert(file,0,path);
  711.    IF ~ReadDaten(wurzel,file) THEN
  712.      Assert(ReadDaten(wurzel,filename),ADR("File not found!"));
  713.    END;
  714.    (* Handle saved status *)
  715.    stat := searchStatus(wurzel);
  716.    (* Get actual date *)
  717.    GetDate(Wochentag,Tag,Monat,Jahr);
  718.    OTag := Tag;
  719.    OMonat := Monat;
  720.    OJahr := Jahr-1;
  721.    (* options *)
  722.    WHILE (stat # NIL) AND (stat^.Monat = 0) DO
  723.      CASE stat^.Tag OF
  724.        1 : Copy(argstr,stat^.Text);
  725.            konvdate(OTag,OMonat,OJahr,argstr);|
  726.        2 : Copy(date1,stat^.Text);|
  727.        3 : Copy(date2,stat^.Text);|
  728.        4 : Copy(state,stat^.Text);|
  729.        5 : StrToVal(stat^.Text,zr,sign,10,err);
  730.        ZeitRaum := CARDINAL(zr);|
  731.        6 : StrToVal(stat^.Text,zr,sign,10,err);
  732.            language := SHORTCARD(zr)+1;|
  733.        7 : mark := TRUE;|
  734.        8 : Copy(line,stat^.Text);
  735.      ELSE
  736.      END;
  737.      stat := stat^.next;
  738.    END;
  739.    IF CheckOption("ONCE") THEN
  740.      IF tagdiff(Tag,Monat,Jahr,OTag,OMonat,OJahr) < 0 THEN
  741.        already := FALSE;
  742.        stat := searchStatus(wurzel);
  743.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 1) DO
  744.          stat := stat^.next;
  745.        END;
  746.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 1) THEN
  747.      delete(wurzel,stat);
  748.        END;
  749.        argstr := "";
  750.        format(Tag,argstr,2);
  751.        Concat(argstr,".");
  752.        arg := "";
  753.        format(Monat,arg,2);
  754.        Concat(argstr,arg);
  755.        Concat(argstr,".");
  756.        arg := "";
  757.        format(Jahr,arg,4);
  758.        Concat(argstr,arg);
  759.        insert(wurzel,1,0,0,argstr);
  760.        saveflag := TRUE;
  761.      ELSE
  762.        already := TRUE;
  763.        returnVal := 5;
  764.      END;
  765.    END;
  766.    IF CheckOption("SHOW") THEN
  767.      cptr := GetOptionParam("SHOW",cquot);
  768.      IF cptr # NIL THEN
  769.        StrToVal(cptr^,zr,sign,10,err);
  770.        ZeitRaum := CARDINAL(zr);
  771.        stat := searchStatus(wurzel);
  772.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 5) DO
  773.          stat := stat^.next;
  774.        END;
  775.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 5) THEN
  776.      delete(wurzel,stat);
  777.        END;
  778.        ValToStr(ZeitRaum,FALSE,arg,10,5,'0',err);
  779.        insert(wurzel,5,0,0,arg);
  780.        saveflag := TRUE;
  781.        Killstr(cptr);
  782.      END;
  783.    END;
  784.    IF (ZeitRaum = 0) OR (ZeitRaum > 366) THEN
  785.      ZeitRaum := 31;
  786.    END;
  787.    IF CheckOption("LANGUAGE") THEN
  788.      cptr := GetOptionParam("LANGUAGE",cquot);
  789.      IF cptr # NIL THEN
  790.        StrToVal(cptr^,zr,sign,10,err);
  791.        language := SHORTCARD(zr)+1;
  792.        IF language > 4 THEN
  793.          language := 1;
  794.        END;
  795.        stat := searchStatus(wurzel);
  796.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 6) DO
  797.          stat := stat^.next;
  798.        END;
  799.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 6) THEN
  800.      delete(wurzel,stat);
  801.        END;
  802.        ValToStr(language-1,FALSE,arg,10,3,'0',err);
  803.        insert(wurzel,6,0,0,arg);
  804.        saveflag := TRUE;
  805.        Killstr(cptr);
  806.      END;
  807.    END;
  808.    IF localeBase # NIL THEN
  809.      language := 0;
  810.    END;
  811.    IF CheckOption("MARK") THEN
  812.      mark := ~mark;
  813.      stat := searchStatus(wurzel);
  814.      WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 7) DO
  815.        stat := stat^.next;
  816.      END;
  817.      IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 7) THEN
  818.        delete(wurzel,stat);
  819.      ELSE
  820.        insert(wurzel,7,0,0,"");
  821.      END;
  822.      saveflag := TRUE;
  823.    END;
  824.  
  825.    IF CheckOption("STATUS") THEN
  826.      cptr := GetOptionParam("STATUS",cquot);
  827.      IF cptr # NIL THEN
  828.        Assert(cquot,ADR("STATUS parameter not quoted!"));
  829.        Copy(state,cptr^);
  830.        stat := searchStatus(wurzel);
  831.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 4) DO
  832.          stat := stat^.next;
  833.        END;
  834.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 4) THEN
  835.      delete(wurzel,stat);
  836.        END;
  837.        insert(wurzel,4,0,0,state);
  838.        saveflag := TRUE;
  839.        Killstr(cptr);
  840.      END;
  841.    END;
  842.    slen := specialtext(state,Tag,Monat,Jahr,Jahr,"");
  843.    IF CheckOption("DATE1") THEN
  844.      cptr := GetOptionParam("DATE1",cquot);
  845.      IF cptr # NIL THEN
  846.        Assert(cquot,ADR("DATE1 parameter not quoted!"));
  847.        Copy(date1,cptr^);
  848.        stat := searchStatus(wurzel);
  849.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 2) DO
  850.          stat := stat^.next;
  851.        END;
  852.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 2) THEN
  853.      delete(wurzel,stat);
  854.        END;
  855.        insert(wurzel,2,0,0,date1);
  856.        saveflag := TRUE;
  857.        Killstr(cptr);
  858.      END;
  859.    END;
  860.    IF CheckOption("DATE2") THEN
  861.      cptr := GetOptionParam("DATE2",cquot);
  862.      IF cptr # NIL THEN
  863.        Assert(cquot,ADR("DATE2 parameter not quoted!"));
  864.        Copy(date2,cptr^);
  865.        stat := searchStatus(wurzel);
  866.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 3) DO
  867.          stat := stat^.next;
  868.        END;
  869.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 3) THEN
  870.      delete(wurzel,stat);
  871.        END;
  872.        insert(wurzel,3,0,0,date2);
  873.        saveflag := TRUE;
  874.        Killstr(cptr);
  875.      END;
  876.    END;
  877.    IF CheckOption("LINE") THEN
  878.      cptr := GetOptionParam("LINE",cquot);
  879.      IF cptr # NIL THEN
  880.        Assert(cquot,ADR("LINE parameter not quoted!"));
  881.        Copy(line,cptr^);
  882.        stat := searchStatus(wurzel);
  883.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 8) DO
  884.          stat := stat^.next;
  885.        END;
  886.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 8) THEN
  887.      delete(wurzel,stat);
  888.        END;
  889.        insert(wurzel,8,0,0,line);
  890.        saveflag := TRUE;
  891.        Killstr(cptr);
  892.      END;
  893.    END;
  894.    IF CheckOption("NODATA") THEN
  895.      nodata := TRUE;
  896.    END;
  897.    IF CheckOption("NOSAVE") THEN
  898.      save := FALSE;
  899.    END;
  900.    IF ~wbStarted AND CheckOption("INSERT") THEN
  901.      cptr := GetOptionParam("INSERT",cquot);
  902.      Assert(cquot,ADR("INSERT parameter not quoted!"));
  903.      IF cptr # NIL THEN
  904.        Copy(argstr,cptr^);
  905.        konvdate(t,m,j,argstr);
  906.        IF j > 0 THEN
  907.          Assert((maxDays(m,j) > 0) AND (maxDays(m,j)+1 > t),ADR("Wrong date!"));
  908.        ELSE
  909.          Assert((maxDays(m,Jahr) > 0) AND (maxDays(m,Jahr)+1 > t),ADR("Wrong date!"));
  910.        END;
  911.        insert(wurzel,t,m,j,argstr);
  912.        saveflag := TRUE;
  913.        Killstr(cptr);
  914.      END;
  915.    ELSE
  916.      (* Make output *)
  917.      IF ~already THEN
  918.        y := GetOutDays(wurzel,Tag,Monat,Jahr,ZeitRaum,x);
  919.        IF wbStarted THEN
  920.          IF y > 0 THEN
  921.            window2 := OpenWin2(y,x,ADR(state));
  922.          ELSIF nodata THEN
  923.            window2 := OpenWin2(1,19,ADR(state));
  924.            OutputWin2("No data for output!",1,FALSE);
  925.          END;
  926.        END;
  927.        OutDays(wurzel,Tag,Monat,Jahr,ZeitRaum,mark);
  928.        IF (y = 0) AND (~wbStarted) AND nodata THEN
  929.          WriteString("No data for output!"); WriteLn;
  930.        END;
  931.      END;
  932.    END;
  933.    (* Save data if required *)
  934.    IF saveflag AND save THEN
  935.      WriteDaten(wurzel,file);
  936.    END;
  937.    IF wbStarted AND ~already AND ((y > 0) OR nodata) THEN
  938.      REPEAT
  939.        set := Wait(LONGSET{window2});
  940.      UNTIL HandleAction2()^.Action = close;
  941.      CloseWin2;
  942.    END;
  943.    CloseRexxPort(port);
  944.  END Kalender.
  945.