program loan (input, output);

label
   100, 120;
var
   loanmonth,loanyear,months : integer;
   years, n, power :integer;
   principal,totpayment,totintpmnt : real;
   rate, annualrate, i, c, payment : real;
   q2 : char;
   OK : boolean;
   console,printer : integer;

function getchar: char; forward;

procedure readprincipal;
   begin
   writeln;
   write ('   Enter the amount of the loan    ==> ');
   readln (principal);
   end; {readprincipal}
procedure readterm;
var OK : boolean;

   begin
   Repeat
   OK := TRUE;
   writeln;
   writeln ('   Enter the term of the loan in years and months.');
   writeln;
   write ('                          YEARS    ==> ');
   readln (years);
   if (years < 0)  or (years  > 9999) then OK := FALSE;
   write ('                          MONTHS   ==> ');
   readln (months);
   if (months < 0) or (months > 12) then Ok := FALSE;
   n :=round( 12 * years + months);
   If not OK then writeln('   Incorrect data entry.  Try again.');
   Until OK
   end; {readterm}

procedure readrate;
   begin
   writeln;
   write ('   Enter the rate                  ==> ');
   readln (rate);
   end; {Readrate}

procedure readdate;
begin
writeln('   Enter the date of the first payment: ');
writeln;
write  (  '     Enter the month (use numbers) ==> ');
readln (loanmonth);
write  (  '     Enter the year                ==> ');
readln (loanyear);
If loanyear < 100 then
   loanyear := loanyear + 1900;
end;               { END READDATE }


Procedure printtable (lmonth,lyear,loanterm :integer) ;

label 150,500;
var
   beginmonth,endmonth, mnth : integer;
   beginyear,endyear,index,j,m,yr,currentyear : integer;
   answer,q1 : char;
   yearinterest,interestpayment, principalpayment, balance :real;
   limits, exit : boolean;

procedure setlimits;
label 150,500;
begin
writeln(chr(26));
150: writeln('    It is possible for the program to display a table for the whole');
writeln('    term of the loan, or else to limit the table to given dates.');
writeln('    To print the entire table ENTER THE SPACE BAR.');
writeln('    To set limits to the printout ENTER [L].');
answer := getchar;
if (upcase(answer)='L') then
begin
   writeln(chr(26));
500: writeln('     Enter the month and year beginning the table using this format:');
   writeln('      Example:      2 1984  [CR]');
   writeln;
   write  ('         ==> ');
   readln(beginmonth,beginyear);
   If beginyear < 100 then beginyear := beginyear + 1900;
  If (beginyear < lyear) then
     begin
       writeln ('   Incorrect data entry.  The year preceeds the beginning ');
       writeln ('   of the loan period.  Try again.');writeln;
       Goto 500;
     end;
   If (beginmonth < lmonth) and (beginyear = lyear) then
	begin      
	Writeln('Incorrect data entry. Entered date preceeds beginning of loan period');
	end;
   writeln('     Enter the month and year ending the table, using this format:');
   writeln('      Example:     6 1986  [CR]');
   writeln;
   write  ('         ==> ');
   readln(endmonth,endyear);
   If endyear < 100 then endyear := endyear + 1900;
 end;
if upcase(answer)= ' ' then
   begin
   beginmonth:=lmonth;
   beginyear := lyear;
   endmonth := 1;
   endyear := 9999;
   end;
if (upcase(answer) <> 'L') and (upcase(answer) <> ' ') then
     begin
     writeln;
     writeln('  Incorrect entry.  Try again. ');
     writeln;
     goto 150;
     end;
end;    { procedure limits }

procedure printit;
begin
writeln;
writeln('     To send the table to the printer ENTER "Y"');
writeln('     To send the table to the console only ENTER THE SPACE BAR');
q1 := getchar;
if upcase(q1)='Y' then
   conoutptr := printer;
end;      {procedure printit}

begin    {Main Procedure}  
setlimits;
printit;
balance := principal;
mnth := lmonth;
currentyear := lyear;
writeln;writeln;writeln;writeln;writeln;writeln;
writeln ('     Table of monthly payments on a ',years:1,'-year and ',months:1,'-month loan');
writeln ('     of $', principal :1:2, ' at ', rate:1:2,' percent interest rate.');
writeln;
index :=4;
limits := false;
yearinterest := 0;
exit := false;
j := 0;
while (j < loanterm)  and (not exit) do
   begin
     j := j + 1;
     if (mnth = beginmonth) and (currentyear = beginyear) then
           limits := true;
     if limits then
        index := index + 1;
     if (index = 5) and limits then
         begin
            writeln;writeln;
            writeln (' #':4,'Month  Year  ':16,'Payment ':12,'Interest': 10,'Principal':15, 'Balance' :15);
         writeln;
         end;
     interestpayment := i*balance;
     principalpayment := payment - interestpayment;
     balance := balance - principalpayment;
     yearinterest :=yearinterest + interestpayment;
     If limits then
        begin
    writeln(j:5,mnth:6,currentyear:7,payment:12:2,interestpayment:11:2,principalpayment:15:2,balance:16:2);
          if (index >= 54) then
            begin
              writeln(chr(12));
              writeln;writeln;writeln;writeln;
              index := 4;
            end;
         end; {  if limits }
      If (mnth = endmonth) and (currentyear = endyear) then
         begin
         exit := true;
         end;
     if (mnth = 12) then
        begin
          mnth :=1;
        if limits then 
         begin
          writeln ('  Total interest paid in ',currentyear:4,' is ',yearinterest:7:2,'.');
          writeln;
         index := index + 2;
         end; 
          yearinterest:= 0;
          currentyear := currentyear + 1;
        end
      else
        mnth := mnth + 1;
      end;  {while not exit loop}
if (mnth <> 1) and (endyear = 9999) then
writeln ('  Total interest paid in ',currentyear:4,' is ',yearinterest:7:2,'.');
if (upcase(q1)) = 'Y' then
 begin
 write(chr(12));
 conoutptr :=console;
 end;
end;  {printtable}

procedure calc_monthly_payment;
begin
writeln(chr(26));
   annualrate := rate / 100;
   i := annualrate / 12;
   c:=exp( n*ln(1+i) );
   payment := principal * i * c / (c-1);
   totpayment := payment * n;
   totintpmnt := totpayment - principal;
writeln ('   The monthly payment on a loan of  $',principal   :1:2);
writeln ('   with a term of ',years:1 ,'-year and ',months,'-months ');
writeln ('   at ',rate:1:2, '% is:');
writeln ('       $', payment:1:2, '.');
writeln;
writeln ('   The total amount paid over the term of the loan will be:');
writeln ('       $', totpayment:1:2,'.');
writeln ('   The total interest paid out will be:');
writeln ('       $',totintpmnt:1:2,'.');
writeln;
end; {calc_monthly_payment}

function getchar;
var
intansw : integer;

begin
intansw := BDOS (1);
getchar := chr(intansw)
end;  { getchar }

begin {Main Program}
ClrScr;
console := conoutptr;printer := lstoutptr;years:=0;months:=0;loanmonth:=0;
loanyear:=0;
writeln ('   BANKLOAN -- (c) 1985,1984 by Cameron Hall, Monterey CA.');
writeln ('               Released to the Public Domain.');
writeln ('               Version 2.3 -- January 1985.');
writeln;
writeln ('   This program will calculate equal monthly payments on a loan,');
writeln ('   given the amount borrowed, interest rate and term.  Simply ');
writeln ('   enter the data as you are asked for it. It will be possible ');
writeln ('   to modify the data after the payments have been presented.');
writeln ;
readdate;
readprincipal;
readrate;
readterm;
calc_monthly_payment;
Repeat
OK := False;
writeln;
writeln ('Select from the following list of options: ');
writeln;
writeln ('   (A) PRINT A TABLE of monthly payments and interest charges.');
writeln ('   (B) CHANGE AMOUNT of loan. ');
writeln ('   (C) CHANGE INTEREST RATE.');
writeln ('   (D) CHANGE TERM.');
writeln ('   (E) CHANGE AMOUNT, RATE, and TERM.');
writeln ('   (F) CHANGE DATE of the loan.  ');
writeln ('   (G) REDISPLAY CALCULATION of monthly payments. ');
writeln ('   (H) SEND CALCULATION  TO THE PRINTER.');
writeln ('   (X) EXIT PROGRAM. ');
q2 := getchar;
writeln;
case q2 of
   'A', 'a' : begin
              printtable(loanmonth,loanyear,n);
              end;
   'B', 'b' : begin
               readprincipal;
               calc_monthly_payment;
               end;
   'C' ,'c' :begin
             readrate;
             calc_monthly_payment;
             end;
   'D' ,'d' :begin
             readterm;
             calc_monthly_payment;
             end;
   'E' ,'e' :begin
             readprincipal;
             readrate;
             readterm;
             calc_monthly_payment;
             end;
   'F' ,'f' :begin
             readdate;
             calc_monthly_payment;
             end;
   'G','g'  :calc_monthly_payment;
   'H','h'  :begin
             conoutptr := printer;
             writeln;writeln;writeln;writeln;
            calc_monthly_payment;
            write(chr(12));
            conoutptr := console;
            end;
   'X' ,'x' :BDOS(0);
    else
        OK := False;
end; { case statement }
Until OK;
end.