Program Kalender ;
(* This German program generates one or more calenders into a file	*)
(* B:CALENDER.TXT.  The form of the calender is such that it can be	*)
(* easily appended to graphics, eg. Snoopy etc.				*)
(* The program was 'lifted' directly from a German book on programming	*)
(* and required only minor changes to work ( the IO had to be fixed)	*)
(* I thing this demonstrates the true portability of the PASCAL system  *)


Type Twochtag	=	(So,Mo,Di,Mi,Don,Fr,Sa);
     Tmonat	=	(Jan,Feb,Mrc,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
     Tmonatag	=	0..31;
     Tjahr	=	1583..3000;
     Tmonalis	=	Array (. Tmonat .) of
			Record
				Anftag	:	Twochtag;
				Laenge	:	28..31  ;
				Name	:	Array (. 1..9 .) of Char;
			End;
     TBuf       =       Array (. Tmonat .) of
                        Record
                                Line    :       Array (.1..80 .) of Char;
                        End;


Var Jahrx, Jahry, J, Jahrb		:	Tjahr;
    Wochtagb				:	Twochtag;
    Monalis				:	Tmonalis;
    Cono				:	Text;
    Out					:	Text;
    Buf					:	Tbuf;




Procedure Vorspann ;

Var Monindex	:	Tmonat;

Begin
    Jahrb := 1980;
    Wochtagb := Di;
    With Monalis (. Jan .) Do
	Begin Laenge:=31; Name:='January  '	End;
    With Monalis(. Feb.)   Do  Name :='February ';
    With Monalis(. Mrc.)   Do
	Begin Laenge:=31; Name:='March    ' End;
    With Monalis(.Apr.)    Do
	Begin Laenge:=30; Name:='April    ' End;
    With Monalis(. May.)   Do
	Begin Laenge:=31; Name:='May      ' End;
    With Monalis(. Jun.)   Do
	Begin Laenge:=30; Name:='June     ' End;
    With Monalis(.Jul.)    Do
	Begin Laenge:=31; Name:='July     ' End;
    With Monalis(.Aug.)    Do
	Begin Laenge:=31; Name:='August   ' End;
    With Monalis(.Sep.)    Do
	Begin Laenge:=30; Name:='September' End;
    With Monalis(.Oct.)    Do
	Begin Laenge:=31; Name:='October  ' End;
    With Monalis(.Nov.)    Do
	Begin Laenge:=30; Name:='November ' End;
    With Monalis(.Dec.)    Do
	Begin Laenge:=31; Name:='December ' End;
	
End (* Vorspann *) ;





Function Schalt (Jahr : Tjahr ) :  Boolean;

Begin
    Schalt := (( Jahr Mod 4 = 0) And ( Jahr Mod 100 <> 0))
              Or ( Jahr Mod 400 = 0)

End (* Schalt  *)  ;



Function Wtag ( I : Integer )  : Twochtag;

Begin
    I:=I Mod 7;
    If I< 0 Then I:=7+I;
    Case I Of
	0: Wtag:=So; 1: Wtag:=Mo; 2: Wtag:=Di; 3: Wtag:= Mi;
	4: Wtag:=Don; 5: Wtag:=Fr; 6: Wtag:=Sa;
    End;
End (* Wtag  *)  ;


Procedure InitJahr ( Jahrz  : Tjahr );
Var Wochtagz	: Twochtag;
    Tagnr	: Integer;
    J		: Tjahr;
    Monindex	: Tmonat;


Begin
    Tagnr:=0;
    If Jahrz = Jahrb Then Wochtagz := Wochtagb;
    If Jahrz > Jahrb Then
	Begin
	For J:= Jahrb to Jahrz-1 Do
	    If Schalt (J) Then Tagnr:=Tagnr+366
	    Else Tagnr:=Tagnr+365;
	Wochtagz:=Wtag(Ord(Wochtagb)+Tagnr)
	End
    Else
	Begin
	For J:=Jahrb-1 Downto Jahrz Do
	    If Schalt (J) Then Tagnr:=Tagnr+366
            Else Tagnr:= Tagnr+365;
        Wochtagz:=Wtag(Ord(Wochtagb)-Tagnr)
	End  ;
	
	
    Monalis(.Jan.).Anftag :=Wochtagz;
    If Schalt(Jahrz) then Monalis(.Feb.).Laenge:=29
    Else Monalis(.Feb.).Laenge:=28;
    
    For Monindex:=Feb to Dec Do
	Monalis(.Monindex.).Anftag:=
	  Wtag(Ord(Monalis(.Pred(Monindex).).Anftag)
	  + Monalis(.Pred(Monindex).).Laenge)

End  (* Initjahr  *);




Procedure Writemonate ( Jahrz  : Tjahr );

Var I :0..33;
    H :Tmonat;

Begin
    
    For H:=Jan to Dec Do
	Begin
	Writeln('  ');
	Writeln( Monalis(.H.).Name , Jahrz:5);
	Write( ' ');
	For I:=1 to 5 Do
	    Write (' Su Mo Tu We Th Fr Sa' );
        Writeln(' Su Mo Tu ');
        Write(' ':Ord(Monalis(.H.).Anftag)*3+1);
	For I:=1 To Monalis(.H.).Laenge Do
	    Write(I:3 );
	Writeln;
	Writeln('  ');
    End;
End  (* Writemonat *)  ;


Procedure Println( M1: Tmonat; M2: Tmonat; M3: Tmonat);

Var	I, J,K	:	Integer;
	M1s,M2s,M3s:	Integer;
        C1,C2,C3   :    Integer;
	Cycle	:	Integer;


Begin
I:=1;
J:=1;
K:=1;
M1s:=Ord(Monalis(.M1.).anftag);
M2s:=Ord(Monalis(.M2.).anftag);
M3s:=Ord(Monalis(.M3.).anftag);
C1:=M1s; C2:=M2s; C3:=M3s;

Writeln(Out,' ');
Writeln(Out,
' Su Mo Tu We Th Fr Sa      Su Mo Tu We Th Fr Sa      Su Mo Tu We Th Fr Sa');
Writeln(Out);
For Cycle :=1 to 6 Do
Begin
    If M1s <> 0 Then	    Write(Out,' ':M1s*3);
    While (7*Cycle-C1 >0)  Do

   Begin
	If I<= Monalis(.M1.).Laenge Then
	Write(Out,I:3) Else Write(Out,'   '); I:=I+1; C1:=C1+1;
    End;
    
    Write(Out,' ':5+3*(7*Cycle-C1));
    If M2s <> 0 Then Write(Out,' ':M2s*3);
    While (7*Cycle-C2 >0)  Do

   Begin
	If J<= Monalis(.M2.).Laenge Then
	Write(Out,J:3) Else Write(Out,'   '); J:=J+1; C2:=C2+1;
    End;
    
    Write(Out,' ':5+3*(7*Cycle-C2));
    If M3s <> 0 Then Write(Out,' ':M3s*3);
    While (7*Cycle-C3 >0)  Do

   Begin
	If K<= Monalis(.M3.).Laenge Then 
	Write(Out,K:3) Else Write(Out,'   '); K:=K+1; C3:=C3+1;
    End;
    M1s:=0; M2s:=0; M3s:=0;
    Writeln(Out,' ');
End;
Writeln(Out,' ');
End;



Begin
    Reset('CON:' , Cono);
    Rewrite('B:CALENDER.TXT',Out);
    Writeln(' CALENDER Started ');
    Writeln(' Input first-year for Calender creation e.g  1982');
    
    Vorspann  ;
    Readln;
    Read ( Jahrx);
    Writeln(' Input the end-year for Calender creation   ');
    Read (Jahry );
    For J:= Jahrx to Jahry Do
	Begin 
	Initjahr(J);
	Writeln(Out,'                                  ',J:4);
	Writeln(Out,' ');	
	Writeln(Out,
'        January                 February                    MarcКѕ6#6 >!їѕЪ)*ї& P	~ю К":їЦЦџх:їЦЦџБH±х:їЦЦџБH±х:їЦЦџБH±х:їЦЦџБH±Ъ"!ѕ6 !ї4ВЙ:ѕТ_ННjЪYНO
НjТM*џ"ЎГS*я"ЎНИ
Г3Н@ГbНl*ѕMН1ЙяяџН“µЖяџЙ!  "А"ДН7	*MН^Ђ Н†	\ Н”!  "В:®ЦяЖяџАВхНЋџБHЎТД*В#"ВН§ГќН/	:®юяВе> ДН›µВб9НЇ	Н.Й*В#"А:®ж‡‡‡‡‡_ !Ђ е'Н
!'6 !36 'ЕН
:1/!a¶ТE*Д#"Д>НzµВ?CН9НIНІГЃЙН.!Ж6>!ЖѕЪ‡*Ж& '	~2Зю КЂ:Жю	Вy.Н*ЗMН!Ж4ВQЙ> !”ѕТ›:”=2ГЎ:ь2Й:цТ¬Н\> !”ѕТї:”=2KГЕ:ьКѕ6#6 >!їѕЪ)*ї& P	~ю К":їЦЦџх:їЦЦџБH±х:їЦЦџБH±х:їЦЦџБH±х:їЦЦџБH±Ъ"!ѕ6 !ї4ВЙ:ѕТ_ННjЪYНO
Нj
.