{ MaxonPascal3-Anpassung / Test: Falk Zühlsdorff (PackMAN) 1994 }

Program Wochentag;

{$incl 'dos.lib'};

Const
  Fett     = #$1b'[1m';
  Norm     = #$1b'[0m';
  Unterstr = #$1b'[4m';

Type Modus = (Wochentag, Monatskalender, Jahreskalender, Differenz, Inform);

Var day,monat,jahr: integer;
    para: string;
    Mode: Modus;
    Dosdatum: Datestamp;
    yho:p_Datestamp;
    Heute, Tage: Long;

Function Tagname(i:integer):Str;
  Begin
    Case i Of
    0: Tagname:='Montag';
    1: Tagname:='Dienstag';
    2: Tagname:='Mittwoch';
    3: Tagname:='Donnerstag';
    4: Tagname:='Freitag';
    5: Tagname:='Samstag';
    6: Tagname:='Sonntag'
    End;
  End;

Function Monatname(i:integer):Str;
  Begin
    Case i Of
     1: Monatname:='Januar';
     2: Monatname:='Februar';
     3: Monatname:='März';
     4: Monatname:='April';
     5: Monatname:='Mai';
     6: Monatname:='Juni';
     7: Monatname:='Juli';
     8: Monatname:='August';
     9: Monatname:='September';
    10: Monatname:='Oktober';
    11: Monatname:='November';
    12: Monatname:='Dezember';
    End;
  End;

Function Monatstage(monat,jahr:integer):integer;
  { Anzahl der Tage eines Monats ermitteln.
    Das Jahr muß wg. Februar in Schaltjahren angegeben werden. }
  Begin
    Case monat of
      1,3,5,7,8,10,12: Monatstage := 31;
      4,6,9,11: Monatstage := 30;
      2: If (jahr mod 4=0) and ((jahr mod 100<>0) or (jahr mod 400=0)) Then
           Monatstage := 29
         Else
           Monatstage := 28;
    End
  End;


Function Anzahl(t,m,j:integer):Long;
  { Anzahl der seit Donnerstag, dem 1.1.1600 vergangenen Tage }
  Var r: Long;
      i: integer;
  Begin
    r := 365*Long(j-1600)      { normale Tage }
       + Long(j-1600) div 4    { Schaltjahre }
       - Long(j-1600) div 100  { Jahrhunderte keine Schaltjahre }
       + Long(j-1600) div 400; { Alle 400 Jahre doch }
    If (j mod 4=0) and ((j mod 100<>0) or (j mod 400=0)) and (m > 2)
      Then r := r+1;       { In Schaltjahren ab Februar 1 Tag mehr }
    For i:=1 To m-1 Do r := r+Monatstage(i,j);
    Anzahl := r + t - 1
  End;


Procedure MonthCal(monat,jahr:integer);
  Var i,j,k,mt,t: integer;
      a: Array[1..7,1..8] of Boolean;
  Begin
    writeln;
    writeln(Fett,Unterstr,Monatname(Monat),' ',Jahr);
    writeln(Norm,Fett);
    writeln('     Mo        Di        Mi        Do        Fr        Sa        So',Norm);
    mt := Monatstage(monat,jahr);
    For i:=1 to 8 do
      Begin
        t := 7*i-7+1-(Anzahl(1,monat,jahr)+6) mod 7;
        For k:=0 to 6 do
          a[k+1,i] := (k+t>=1) and (k+t<=mt);
      End;
    i := 1;
    Repeat
      CBreak;
      For j:=1 to 7 do
        If a[j,i] or (i>1) and a[j,i-1]
          Then write('----------')
          Else write('          ');
        If a[7,i] or (i>1) and a[7,i-1] then write('-');
        writeln;
      For j:=1 to 7 do
        Begin
          CBreak;
          t := 7*(i-1)-(Anzahl(1,monat,jahr)+6) mod 7;
          If a[j,i] Then write('|',t+j:2,'       ')
          Else If (j>1) and a[j-1,i] Then write('|         ')
                                     Else write('          ')
        End;
        If a[7,i] then write('|');
        writeln;
      For k:=1 to 6 do
        Begin
          CBreak;
          For j:=1 to 7 do
            If a[j,i] Then write('|         ')
            Else If (j>1) and a[j-1,i] Then write('|         ')
                                       Else write('          ');
          If a[7,i] then write('|');
          writeln
        End;
      i := i+1
    Until not(a[1,i-1] or a[7,i-1]);
  End;


Procedure Zahlenbanner(n,posn: integer);
  Type Feldtyp = Array[0..5,0..9] of string[6];
  Var i:integer;
      f: Feldtyp; Static;
  Procedure Rekurs(z,l:integer);
    Begin
      If z>=10 Then Rekurs(z div 10,l);
      write(' ',f[l,z mod 10],' ')
    End;

  Begin
  f := Feldtyp(
  (" *** ","  *  "," *** ","**** ","*    ","*****"," *** ","*****"," *** "," *** "),
  ("*   *"," **  ","*   *","    *","*  * ","*    ","*    ","    *","*   *","*   *"),
  ("*   *","* *  ","   * "," *** ","*  * ","**** ","**** ","   * "," *** "," ****"),
  ("*   *","  *  ","  *  ","    *","*****","    *","*   *","  *  ","*   *","    *"),
  ("*   *","  *  "," *   ","    *","   * ","    *","*   *"," *   ","*   *","    *"),
  (" *** "," *** ","*****","**** ","   * ","**** "," *** ","*    "," *** "," *** "));
  For i:=0 to 5 do
    Begin
      write('':posn);
      Rekurs(n,i);
      writeln
    End;
  End;


Procedure YearCal(jahr: integer);
  Var i,mon,k,t,s,mt:integer;
  Begin
    write(Fett);
    Zahlenbanner(jahr,22);
    write(Norm);
    For i:=0 to 3 Do
      Begin
        CBreak;
        writeln(Fett);
        For mon := 3*i+1 to 3*i+3 Do
          Case mon Of
          1: write('        Januar           ');
          2: write('        Februar          ');
          3: write('         März            ');
          4: write('        April            ');
          5: write('         Mai             ');
          6: write('         Juni            ');
          7: write('         Juli            ');
          8: write('        August           ');
          9: write('       September         ');
          10:write('        Oktober          ');
          11:write('       November          ');
          12:write('       Dezember          ');
          End;
        writeln(Norm);
        For mon := 1 to 3 do
          write(' ',unterstr,'Mo Di Mi Do Fr Sa ',Fett,'So',Norm,'    ');
        CBreak;
        For k:=0 to 5 do
          Begin
            writeln;
            For mon := 3*i+1 to 3*i+3 do
              Begin
                mt := Monatstage(mon,jahr);
                t := 7*k+1-(Anzahl(1,mon,jahr)+6) mod 7;
                For s:=t to t+6 do
                  Begin
                    CBreak;
                    If s=t+6 Then write(Fett);
                    If (s>=1) And (s<=mt) Then
                      write(s:3)
                    Else
                      write('   ')
                  End;
                write(Norm,'    ');
              End;
          End;
        writeln;
      End
  End;


FUNCTION Fehler:boolean;
  Begin
    writeln('Syntax: cal [[<tag>] <monat>] <jahr> [-]');
    fehler:=true;
  End;


Function Parse: Modus;
  { Parameterstring auswerten und Modus zurückgeben.
    Jahr, Monat und Tag global setzen.                  }
  Var p: integer;
      c: Char;
  Procedure Get;   { Nächstes Zeichen aus Eingabe lesen }
    Begin
      c := Upcase(para[p]);
      If c >= ' ' Then p:=p+1 else c:=chr(0);
    End;
  Procedure Over;  { Leerzeichen überlesen }
    Begin
      While c=' ' Do Get
    End;
  Procedure Over2;  { Trennzeichen überlesen }
    Begin
      While c in ['.', '-', '/', ' '] Do Get;
    End;
  Procedure GetNum(Var n:integer);
    { Zahl lesen }
    Begin
      n :=0;
      While c in ['0'..'9'] Do
        Begin
          n := 10*n+ ord(c)-ord('0');
          get
        End;
    End;
  Procedure GetMonth(Var m:integer);
    { Monat lesen oder Fehler melden }
    Var i:integer; s:String;
    Begin
      s:='';
      While c In ['A'..'Z','Ä','Ö','Ü'] Do
        Begin
          s:=s+c;
          Get
        End;
      s[4]:=chr(0);     { Nur erste 3 Buchstaben bertachten }
      If s='JAN' Then m:=1 Else
      If s='FEB' Then m:=2 Else
      If(s='MÄR')or(s='MAR')or(s='MAE') Then m:=3 Else
      If s='APR' Then m:=4 Else
      If(s='MAI')or(s='MAY') Then m:=5 Else
      If s='JUN' Then m:=6 Else
      If s='JUL' Then m:=7 Else
      If s='AUG' Then m:=8 Else
      If s='SEP' Then m:=9 Else
      If(s='OKT')or(s='OCT') Then m:=10 Else
      If s='NOV' Then m:=11 Else
      If(s='DEZ')or(s='DEC') Then m:=12 Else IF Fehler THEN exit;
    End;

  Begin { "Parse" }
    p := 1;
    Get; Over;
    If c='?' Then
      Begin
        Parse:=Inform;
        Get
      End
    Else
    If c in ['0'..'9'] Then
      Begin
        GetNum(Jahr);
        Over2;
        If c=chr(0) Then Parse := Jahreskalender
        Else
        If c in ['0'..'9'] Then
          Begin
            Monat := Jahr;
            Getnum(jahr);
            Over2;
            If c=chr(0) Then Parse := Monatskalender
            Else
            If c in ['0'..'9'] Then
              Begin
                day := Monat;
                Monat := Jahr;
                Getnum(Jahr);
                Over;
                If c=chr(0) Then Parse := Wochentag
                Else If c='-' Then
                  Begin Parse := Differenz; Get End
                Else IF Fehler THEN exit;
              End
            Else IF Fehler THEN exit;
          End
        Else  { zweiter Parameter keine Zahl }
          Begin
            day := Jahr;
            GetMonth(Monat);
            Over2;
            If c In ['0'..'9'] Then GetNum(Jahr)
                               Else IF Fehler THEN exit;
            Parse := Wochentag;
            Over;
            If c=chr(0) Then Parse := Wochentag
            Else If c='-' Then
              Begin Parse := Differenz; Get End
            Else IF Fehler THEN exit;
          End;
      End
    Else { erster Parameter keine Zahl }
      Begin
        GetMonth(Monat);
        Over2;
        If c In ['0'..'9'] Then GetNum(Jahr) Else IF Fehler THEN exit;
        Parse := Monatskalender;
      End;
    Over;
    If c<>chr(0) Then IF Fehler THEN exit;{ keine weiteren Parameter zulassen }
  End;

Begin
  If FromWB Then Halt(0);
  If (Parameterlen=0) or (Parameterlen>78) Then IF Fehler THEN exit;;
  para := Parameterstr; para[parameterlen+1]:=chr(0);
  Mode := Parse;
  If Mode<>Inform Then
    If Jahr in [0..99] Then Jahr:=Jahr+1900
    Else
    If not(Jahr in [1600..9999]) Then Error('Falsches Jahr!');
  Case Mode Of
    Wochentag: If (Monat<1) or (Monat>12) Then Error('Falscher Monat!')
               Else If (day<1) or (day>Monatstage(Monat,Jahr)) Then
                 Error("Falscher Tag")
               Else
               writeln(day,'. ', Monatname(Monat),' ',jahr,': ',
                 Tagname((Anzahl(day,monat,jahr)+6) mod 7 ));
    Monatskalender: If (Monat<1) or (Monat>12) Then Error('Falscher Monat!')
                    Else MonthCal(Monat,Jahr);
    Jahreskalender: YearCal(jahr);
    Differenz:  If (Monat<1) or (Monat>12) Then Error('Falscher Monat!')
                Else If (day<1) or (day>Monatstage(Monat,Jahr)) Then
                  Error("Falscher Tag")
                Else
                Begin
                  yho:=_Datestamp(^Dosdatum);
                  If Dosdatum.ds_days=0 Then
                    Error("Datum ist nicht gesetzt.");
                  Tage := Anzahl(day,monat,jahr);
                  Heute :=Anzahl(1,1,1978)+Dosdatum.ds_days;
                  If Heute <= Tage Then
                    write('In ',Tage-Heute,' Tagen ist ')
                  Else
                    write('Vor ',Heute-Tage,' Tagen war ');
                  Writeln(Tagname((Tage+6) mod 7 ), ', der ',
                          day, '. ', Monatname(monat),' ', jahr,'.');
                End;
    Inform: Begin
            writeln('CAL - Das universelle Kalenderprogramm');
            writeln('Geschrieben von Jens Gelhar 1990');
            writeln('Syntax:  cal <jahr>                  Jahreskalender');
            writeln('         cal <monat> <jahr>          Monatskalender');
            writeln('         cal <tag> <monat> <jahr>    Wochentag ausgeben');
            writeln('         cal <tag> <monat> <jahr> -  Differenz zu heutigem Datum');
            End;
  End;
  writeln
End.