home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / 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(zeiger);
  349.        END;
  350.      END;
  351.      zeiger := zeiger^.next;
  352.    END;
  353.    RETURN(NIL);
  354.  END search;
  355.  
  356.  
  357.  PROCEDURE searchStatus(Line : point) : point;
  358.  
  359.  BEGIN
  360.    Line := search(Line,0,0);
  361.    RETURN(Line);
  362.  END searchStatus;
  363.  
  364.  
  365.  PROCEDURE specialtext(VAR str : ARRAY OF CHAR; Tag,Monat : SHORTCARD; Jahr : CARDINAL; jahr : CARDINAL; insertstr : ARRAY OF CHAR) : SHORTCARD;
  366.  
  367.  VAR i            : INTEGER;
  368.      istr        : tstring;
  369.      err        : BOOLEAN;
  370.      wt            : wtstring;
  371.      del        : SHORTCARD;
  372.      dcount,count    : SHORTCARD;
  373.      wlen        : SHORTCARD;
  374.  
  375.    PROCEDURE insl(VAR wt : wtstring; wlen : SHORTCARD);
  376.  
  377.    VAR
  378.     len : SHORTCARD;
  379.  
  380.    BEGIN
  381.      len := SHORTCARD(Length(wt));
  382.      WHILE len < wlen DO
  383.        wt[len+1] := ' ';
  384.        wt[len+2] := CHAR(0);
  385.        INC(len);
  386.      END;
  387.    END insl;
  388.  
  389.  BEGIN
  390.     count := 0;
  391.     i := Occurs(str,first,"%",FALSE);
  392.     WHILE i # last DO
  393.       istr := "";
  394.       del := 2;
  395.       CASE str[i+1] OF
  396.         "d" : ValToStr(Tag,FALSE,istr,10,2,"0",err);
  397.           Insert(str,i+2,istr);|
  398.         "m" : ValToStr(Monat,FALSE,istr,10,2,"0",err);
  399.           Insert(str,i+2,istr);|
  400.     "o" : wlen := monat(Monat,wt,language);
  401.           IF str[i+2] = 'l' THEN
  402.             insl(wt,wlen);
  403.             del := 3;
  404.           END;
  405.               Insert(str,i+INTEGER(del),wt);|
  406.         "y" : ValToStr(Jahr,FALSE,istr,10,4,"0",err);
  407.           Insert(str,i+2,istr);|
  408.         "w" : wlen := wochentag(Weekday(Tag,Monat,jahr),wt,language);
  409.           IF str[i+2] = 'l' THEN
  410.             insl(wt,wlen);
  411.             del := 3;
  412.           END;
  413.           Insert(str,i+INTEGER(del),wt);|
  414.         "n" : ValToStr(Weekday(Tag,Monat,jahr),FALSE,istr,10,1,"0",err);
  415.           Insert(str,i+2,istr);|
  416.         "e" : ValToStr(GetWeek(Tag,Monat,jahr),FALSE,istr,10,2,"0",err);
  417.           Insert(str,i+2,istr);|
  418.     "t" : Insert(str,i+2,insertstr);|
  419.     "1" : Insert(str,i+2,date1);|
  420.     "2" : Insert(str,i+2,date2);
  421.       ELSE
  422.         del := 0;
  423.         INC(dcount);
  424.       END;
  425.       Delete(str,i,del);
  426.       i := Occurs(str,first,"%",FALSE);
  427.       count := dcount;
  428.       WHILE count > 0 DO
  429.         i := Occurs(str,i+1,"%",FALSE);
  430.         DEC(count);
  431.       END;
  432.     END;
  433.     RETURN(Length(str));
  434.  END specialtext;
  435.  
  436.  
  437.  PROCEDURE GetNumberOf(zeiger : point; Tag,Monat : SHORTCARD; VAR maxx : SHORTCARD) : SHORTCARD;
  438.  
  439.  VAR
  440.     anz            : CARDINAL;
  441.     len            : CARDINAL;
  442.     txt            : tstring;
  443.  
  444.  BEGIN
  445.    anz := 0;
  446.    zeiger := search(zeiger,Tag,Monat);
  447.    WHILE zeiger # NIL DO
  448.      IF (zeiger^.Monat = Monat) AND (zeiger^.Tag = Tag) THEN
  449.        IF (Occurs(zeiger^.Text,first,"%k",FALSE) # last) AND (zeiger^.Jahr > 0) THEN
  450.          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
  451.            delete(wurzel,zeiger);
  452.            saveflag := TRUE;
  453.          ELSE
  454.            INC(anz);
  455.            Copy(txt,line);
  456.            len := specialtext(txt,Tag,Monat,Jahr,Jahr,zeiger^.Text);
  457.          END;
  458.        ELSE
  459.          INC(anz);
  460.          Copy(txt,line);
  461.          len := specialtext(txt,Tag,Monat,Jahr,Jahr,zeiger^.Text);
  462.        END;
  463.        IF len > maxx THEN
  464.          maxx := len;
  465.        END;
  466.        zeiger := zeiger^.next;
  467.      ELSIF (zeiger^.Monat = Monat) AND (zeiger^.Tag < Tag) THEN
  468.        zeiger := zeiger^.next;
  469.      ELSIF (zeiger^.Monat > Monat) OR
  470.             ((zeiger^.Monat = Monat) AND (zeiger^.Tag > Tag)) THEN
  471.        zeiger := NIL;
  472.      END;
  473.    END;
  474.    RETURN(anz);
  475.  END GetNumberOf;
  476.  
  477.  
  478.  PROCEDURE GetOutDays(zeiger : point; Tag,Monat : SHORTCARD; Jahr : CARDINAL;
  479.                     ZeitRaum : CARDINAL; VAR x : SHORTCARD) : SHORTCARD;
  480.  
  481.  VAR
  482.     days    : CARDINAL;
  483.     anz    : SHORTCARD;
  484.  
  485.  BEGIN
  486.    anz := 0;
  487.    days := 0;
  488.    zeiger := search(zeiger,Tag,Monat);
  489.    WHILE days < ZeitRaum DO
  490.      anz := anz + GetNumberOf(zeiger,Tag,Monat,x);
  491.      INC(Tag);
  492.      IF Tag > maxDays(Monat,Jahr) THEN
  493.        Tag := 1;
  494.        INC(Monat);
  495.        IF Monat > 12 THEN
  496.          Monat := 1;
  497.          INC(Jahr);
  498.          zeiger := wurzel;
  499.        END;
  500.      END;
  501.      INC(days);
  502.    END;
  503.    RETURN(anz);
  504.  END GetOutDays;
  505.  
  506.  
  507.  PROCEDURE formattext(VAR zeiger : point; VAR text : tstring; Tag,Monat : SHORTCARD;
  508.                 Jahr : CARDINAL; VAR saveflag : BOOLEAN) : BOOLEAN;
  509.  
  510.  VAR
  511.     i,j    : INTEGER;
  512.     str    : ARRAY [1..2] OF CHAR;
  513.     err,ofl    : BOOLEAN;
  514.     len    : SHORTCARD;
  515.     tx    : tstring;
  516.  
  517.  BEGIN
  518.    ofl := TRUE;
  519.    Copy(text,line);
  520.    IF zeiger^.Jahr > 0 THEN
  521.      len := specialtext(text,zeiger^.Tag,zeiger^.Monat,zeiger^.Jahr,Jahr,zeiger^.Text);
  522.    ELSE
  523.      len := specialtext(text,zeiger^.Tag,zeiger^.Monat,Jahr,Jahr,zeiger^.Text);
  524.    END;
  525.    i := Occurs(text,first,"%",TRUE);
  526.    IF i # last THEN
  527.      CASE text[i+2] OF
  528.        "j" : str := "";
  529.              IF zeiger^.Jahr > 0 THEN
  530.                j := Jahr-zeiger^.Jahr;
  531.                ValToStr(j,FALSE,str,10,2," ",err);
  532.              END;
  533.              Insert(text,i+2,str); |
  534.        "k" : IF tagdiff(zeiger^.Tag,zeiger^.Monat,0,Tag,Monat,0) = 0 THEN
  535.            saveflag := TRUE;
  536.              END; |
  537.        "h" : IF tagdiff(zeiger^.Tag,zeiger^.Monat,0,Tag,Monat,0) # 0 THEN
  538.                ofl := FALSE;
  539.              END; |
  540.        "'" : j := Occurs(text,i+3,"'",TRUE);
  541.          IF j # last THEN
  542.            CopyPart(tx,text,i+2,j-(i+2));
  543.            Delete(text,i+2,j-(i+1));
  544.            IF tagdiff(zeiger^.Tag,zeiger^.Monat,0,Tag,Monat,0) = 0 THEN
  545.              IF ~SendRexxMsg(port,"REXX",tx) THEN
  546.                Concat(text," (ERROR!)");
  547.              END;
  548.            END;
  549.          END;
  550.      ELSE
  551.      END;
  552.      Delete(text,i,2);
  553.    END;
  554.    RETURN(ofl);
  555.  END formattext;
  556.  
  557.  
  558.  PROCEDURE OutDays(zeiger : point; Tag,Monat : SHORTCARD; Jahr : CARDINAL;
  559.                     ZeitRaum : CARDINAL; mark : BOOLEAN);
  560.  
  561.  VAR
  562.     anz    : SHORTCARD;
  563.     x    : SHORTCARD;
  564.  
  565.    PROCEDURE textoutput(VAR zeiger : point; Tag,Monat : SHORTCARD;
  566.         Jahr : CARDINAL; VAR saveflag : BOOLEAN; mark : BOOLEAN);
  567.  
  568.    VAR
  569.     ptr    : point;
  570.     text    : tstring;
  571.     sf    : BOOLEAN;
  572.  
  573.    BEGIN
  574.      sf := FALSE;
  575.      IF formattext(zeiger,text,Tag,Monat,Jahr,sf) THEN
  576.        IF mark AND (tagdiff(Tag,Monat,0,zeiger^.Tag,zeiger^.Monat,0) = 0) THEN
  577.          IF sf THEN
  578.            WriteString(revc1);
  579.            saveflag := TRUE;
  580.            ptr := zeiger;
  581.            zeiger := zeiger^.last;
  582.            delete(wurzel,ptr);
  583.          ELSE
  584.            WriteString(normc1);
  585.          END;
  586.        ELSIF mark AND (tagdiff(Tag,Monat,0,zeiger^.Tag,zeiger^.Monat,0) = 1) THEN
  587.          WriteString(normc2);
  588.        END;
  589.        WriteString(text); WriteString(normal); WriteLn;
  590.      END;
  591.    END textoutput;
  592.  
  593.    PROCEDURE windowoutput(VAR zeiger : point; Tag,Monat : SHORTCARD;
  594.         Jahr : CARDINAL; VAR saveflag : BOOLEAN; mark : BOOLEAN);
  595.  
  596.    VAR
  597.     ptr    : point;
  598.     text    : tstring;
  599.     sf    : BOOLEAN;
  600.     col    : SHORTCARD;
  601.     rev    : BOOLEAN;
  602.  
  603.    BEGIN
  604.      rev := FALSE;
  605.      col := 1;
  606.      IF mark AND (tagdiff(zeiger^.Tag,zeiger^.Monat,0,Tag,Monat,0) = 0) THEN
  607.        col := 2;
  608.      ELSIF mark AND (tagdiff(Tag,Monat,0,zeiger^.Tag,zeiger^.Monat,0) = 1) THEN
  609.        col := 3;
  610.      END;
  611.      sf := FALSE;
  612.      IF formattext(zeiger,text,Tag,Monat,Jahr,sf) THEN
  613.        IF sf THEN
  614.          rev := TRUE;
  615.          saveflag := TRUE;
  616.          ptr := zeiger;
  617.          zeiger := zeiger^.last;
  618.          delete(wurzel,ptr);
  619.        END;
  620.        OutputWin2(text,col,rev);
  621.      END;
  622.    END windowoutput;
  623.  
  624.  BEGIN
  625.    zeiger := search(zeiger,Tag,Monat);
  626.    anz := GetOutDays(zeiger,Tag,Monat,Jahr,ZeitRaum,x);
  627.    IF anz > 0 THEN
  628.      IF ~wbStarted AND (slen > 0) THEN
  629.        WriteString(state); WriteLn;
  630.        WriteLn;
  631.      END;
  632.    END;
  633.    WHILE anz > 0 DO
  634.      IF wbStarted THEN
  635.        windowoutput(zeiger,Tag,Monat,Jahr,saveflag,mark);
  636.      ELSE
  637.        textoutput(zeiger,Tag,Monat,Jahr,saveflag,mark);
  638.      END;
  639.      IF zeiger = NIL THEN
  640.        zeiger := wurzel;
  641.        zeiger := search(zeiger,1,1);
  642.        INC(Jahr);
  643.      END;
  644.      zeiger := zeiger^.next;
  645.      IF zeiger = NIL THEN
  646.        zeiger := wurzel;
  647.        zeiger := search(zeiger,1,1);
  648.        INC(Jahr);
  649.      END;
  650.      DEC(anz);
  651.    END;
  652.  END OutDays;
  653.  
  654.  BEGIN
  655.    IF Version[0] # CHAR(0) THEN
  656.    END;
  657.    (* Init *)
  658.    wurzel   := NIL;
  659.    (* Setups *)
  660.    path     := "s:";
  661.    filename := "Kalender.dat";
  662.    language := 1;
  663.    saveflag := FALSE;
  664.    save := TRUE;
  665.    ZeitRaum := 31;
  666.    already := FALSE;
  667.    mark := FALSE;
  668.    nodata := FALSE;
  669.    date1 := "%d.%m.";
  670.    date2 := "%d.%m.%y";
  671.    line := "%1 : %t";
  672.    state := "Terminübersicht am %w, den %d.%m.%y";
  673.    port := OpenRexxPort();
  674.    (* get options *)
  675.    IF ~wbStarted AND CheckOption("?") THEN
  676.      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;
  677.      Terminate;
  678.    END;
  679.    IF ~wbStarted AND CheckOption("HELP") THEN
  680.      WriteString("Kalender version 2.1, Copyright (C) 1993 Kai Hofmann"); WriteLn;
  681.      WriteString("Kalender comes with ABSOLUTELY NO WARRANTY; for details see the 'COPYING'-file"); WriteLn;
  682.      WriteString("This is free software, and you are welcome to redistribute it"); WriteLn;
  683.      WriteString("under certain conditions; see 'COPYING'-file for details."); WriteLn;
  684.      WriteLn;
  685.      WriteString("for detail HELP see Kalender.doc file!"); WriteLn;
  686.      WriteString("or contact me (only email - sorry!): i07m@alf.zfn.uni-bremen.de"); WriteLn;
  687.      Terminate;
  688.    END;
  689.    IF CheckOption("PATH") THEN
  690.      cptr := GetOptionParam("PATH",cquot);
  691.      IF cptr # NIL THEN
  692.        Copy(path,cptr^);
  693.        Killstr(cptr);
  694.      END;
  695.    END;
  696.    Assert(((path[Length(path)] = '/') OR (path[Length(path)] = ":") OR (Length(path) = 0)),ADR("Wrong path!"));
  697.    IF CheckOption("FILE") THEN
  698.      cptr := GetOptionParam("FILE",cquot);
  699.      IF cptr # NIL THEN
  700.        Copy(filename,cptr^);
  701.        Killstr(cptr);
  702.      END;
  703.    END;
  704.    Assert(Length(filename) # 0,ADR("Wrong filename!"));
  705.  
  706.    Copy(file,filename);
  707.    (* Read data *)
  708.    Insert(file,0,path);
  709.    IF ~ReadDaten(wurzel,file) THEN
  710.      Assert(ReadDaten(wurzel,filename),ADR("File not found!"));
  711.    END;
  712.    (* Handle saved status *)
  713.    stat := searchStatus(wurzel);
  714.    (* Get actual date *)
  715.    GetDate(Wochentag,Tag,Monat,Jahr);
  716.    OTag := Tag;
  717.    OMonat := Monat;
  718.    OJahr := Jahr-1;
  719.    (* options *)
  720.    WHILE (stat # NIL) AND (stat^.Monat = 0) DO
  721.      CASE stat^.Tag OF
  722.        1 : Copy(argstr,stat^.Text);
  723.            konvdate(OTag,OMonat,OJahr,argstr);|
  724.        2 : Copy(date1,stat^.Text);|
  725.        3 : Copy(date2,stat^.Text);|
  726.        4 : Copy(state,stat^.Text);|
  727.        5 : StrToVal(stat^.Text,zr,sign,10,err);
  728.        ZeitRaum := CARDINAL(zr);|
  729.        6 : StrToVal(stat^.Text,zr,sign,10,err);
  730.            language := SHORTCARD(zr);|
  731.        7 : mark := TRUE;|
  732.        8 : Copy(line,stat^.Text);
  733.      ELSE
  734.      END;
  735.      stat := stat^.next;
  736.    END;
  737.    IF CheckOption("ONCE") THEN
  738.      IF tagdiff(Tag,Monat,Jahr,OTag,OMonat,OJahr) < 0 THEN
  739.        already := FALSE;
  740.        stat := searchStatus(wurzel);
  741.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 1) DO
  742.          stat := stat^.next;
  743.        END;
  744.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 1) THEN
  745.      delete(wurzel,stat);
  746.        END;
  747.        argstr := "";
  748.        format(Tag,argstr,2);
  749.        Concat(argstr,".");
  750.        arg := "";
  751.        format(Monat,arg,2);
  752.        Concat(argstr,arg);
  753.        Concat(argstr,".");
  754.        arg := "";
  755.        format(Jahr,arg,4);
  756.        Concat(argstr,arg);
  757.        insert(wurzel,1,0,0,argstr);
  758.        saveflag := TRUE;
  759.      ELSE
  760.        already := TRUE;
  761.        returnVal := 5;
  762.      END;
  763.    END;
  764.    IF CheckOption("SHOW") THEN
  765.      cptr := GetOptionParam("SHOW",cquot);
  766.      IF cptr # NIL THEN
  767.        StrToVal(cptr^,zr,sign,10,err);
  768.        ZeitRaum := CARDINAL(zr);
  769.        stat := searchStatus(wurzel);
  770.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 5) DO
  771.          stat := stat^.next;
  772.        END;
  773.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 5) THEN
  774.      delete(wurzel,stat);
  775.        END;
  776.        ValToStr(ZeitRaum,FALSE,arg,10,5,'0',err);
  777.        insert(wurzel,5,0,0,arg);
  778.        saveflag := TRUE;
  779.        Killstr(cptr);
  780.      END;
  781.    END;
  782.    IF (ZeitRaum = 0) OR (ZeitRaum > 366) THEN
  783.      ZeitRaum := 31;
  784.    END;
  785.    IF CheckOption("LANGUAGE") THEN
  786.      cptr := GetOptionParam("LANGUAGE",cquot);
  787.      IF cptr # NIL THEN
  788.        StrToVal(cptr^,zr,sign,10,err);
  789.        language := SHORTCARD(zr);
  790.        IF language > 3 THEN
  791.          language := 0;
  792.        END;
  793.        stat := searchStatus(wurzel);
  794.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 6) DO
  795.          stat := stat^.next;
  796.        END;
  797.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 6) THEN
  798.      delete(wurzel,stat);
  799.        END;
  800.        ValToStr(language,FALSE,arg,10,3,'0',err);
  801.        insert(wurzel,6,0,0,arg);
  802.        saveflag := TRUE;
  803.        Killstr(cptr);
  804.      END;
  805.    END;
  806.    IF CheckOption("MARK") THEN
  807.      mark := ~mark;
  808.      stat := searchStatus(wurzel);
  809.      WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 7) DO
  810.        stat := stat^.next;
  811.      END;
  812.      IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 7) THEN
  813.        delete(wurzel,stat);
  814.      ELSE
  815.        insert(wurzel,7,0,0,"");
  816.      END;
  817.      saveflag := TRUE;
  818.    END;
  819.  
  820.    IF CheckOption("STATUS") THEN
  821.      cptr := GetOptionParam("STATUS",cquot);
  822.      IF cptr # NIL THEN
  823.        Assert(cquot,ADR("STATUS parameter not quoted!"));
  824.        Copy(state,cptr^);
  825.        stat := searchStatus(wurzel);
  826.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 4) DO
  827.          stat := stat^.next;
  828.        END;
  829.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 4) THEN
  830.      delete(wurzel,stat);
  831.        END;
  832.        insert(wurzel,4,0,0,state);
  833.        saveflag := TRUE;
  834.        Killstr(cptr);
  835.      END;
  836.    END;
  837.    slen := specialtext(state,Tag,Monat,Jahr,Jahr,"");
  838.    IF CheckOption("DATE1") THEN
  839.      cptr := GetOptionParam("DATE1",cquot);
  840.      IF cptr # NIL THEN
  841.        Assert(cquot,ADR("DATE1 parameter not quoted!"));
  842.        Copy(date1,cptr^);
  843.        stat := searchStatus(wurzel);
  844.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 2) DO
  845.          stat := stat^.next;
  846.        END;
  847.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 2) THEN
  848.      delete(wurzel,stat);
  849.        END;
  850.        insert(wurzel,2,0,0,date1);
  851.        saveflag := TRUE;
  852.        Killstr(cptr);
  853.      END;
  854.    END;
  855.    IF CheckOption("DATE2") THEN
  856.      cptr := GetOptionParam("DATE2",cquot);
  857.      IF cptr # NIL THEN
  858.        Assert(cquot,ADR("DATE2 parameter not quoted!"));
  859.        Copy(date2,cptr^);
  860.        stat := searchStatus(wurzel);
  861.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 3) DO
  862.          stat := stat^.next;
  863.        END;
  864.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 3) THEN
  865.      delete(wurzel,stat);
  866.        END;
  867.        insert(wurzel,3,0,0,date2);
  868.        saveflag := TRUE;
  869.        Killstr(cptr);
  870.      END;
  871.    END;
  872.    IF CheckOption("LINE") THEN
  873.      cptr := GetOptionParam("LINE",cquot);
  874.      IF cptr # NIL THEN
  875.        Assert(cquot,ADR("LINE parameter not quoted!"));
  876.        Copy(line,cptr^);
  877.        stat := searchStatus(wurzel);
  878.        WHILE (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag # 8) DO
  879.          stat := stat^.next;
  880.        END;
  881.        IF (stat # NIL) AND (stat^.Monat = 0) AND (stat^.Tag = 8) THEN
  882.      delete(wurzel,stat);
  883.        END;
  884.        insert(wurzel,8,0,0,line);
  885.        saveflag := TRUE;
  886.        Killstr(cptr);
  887.      END;
  888.    END;
  889.    IF CheckOption("NODATA") THEN
  890.      nodata := TRUE;
  891.    END;
  892.    IF CheckOption("NOSAVE") THEN
  893.      save := FALSE;
  894.    END;
  895.    IF ~wbStarted AND CheckOption("INSERT") THEN
  896.      cptr := GetOptionParam("INSERT",cquot);
  897.      Assert(cquot,ADR("INSERT parameter not quoted!"));
  898.      IF cptr # NIL THEN
  899.        Copy(argstr,cptr^);
  900.        konvdate(t,m,j,argstr);
  901.        IF j > 0 THEN
  902.          Assert((maxDays(m,j) > 0) AND (maxDays(m,j)+1 > t),ADR("Wrong date!"));
  903.        ELSE
  904.          Assert((maxDays(m,Jahr) > 0) AND (maxDays(m,Jahr)+1 > t),ADR("Wrong date!"));
  905.        END;
  906.        insert(wurzel,t,m,j,argstr);
  907.        saveflag := TRUE;
  908.        Killstr(cptr);
  909.      END;
  910.    ELSIF wbStarted AND CheckOption("EDIT") THEN
  911.      ;
  912.    ELSE
  913.      (* Make output *)
  914.      IF ~already THEN
  915.        y := GetOutDays(wurzel,Tag,Monat,Jahr,ZeitRaum,x);
  916.        IF wbStarted THEN
  917.          IF y > 0 THEN
  918.            window2 := OpenWin2(y,x,ADR(state));
  919.          ELSIF nodata THEN
  920.            window2 := OpenWin2(1,19,ADR(state));
  921.            OutputWin2("No data for output!",1,FALSE);
  922.          END;
  923.        END;
  924.        OutDays(wurzel,Tag,Monat,Jahr,ZeitRaum,mark);
  925.        IF (y = 0) AND (~wbStarted) AND nodata THEN
  926.          WriteString("No data for output!"); WriteLn;
  927.        END;
  928.      END;
  929.    END;
  930.    (* Save data if required *)
  931.    IF saveflag AND save THEN
  932.      WriteDaten(wurzel,file);
  933.    END;
  934.    IF wbStarted AND ~already AND ((y > 0) OR nodata) THEN
  935.      REPEAT
  936.        set := Wait(LONGSET{window2});
  937.      UNTIL HandleAction2()^.Action = close;
  938.      CloseWin2;
  939.    END;
  940.    CloseRexxPort(port);
  941.  END Kalender.
  942.