home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TMORT.ZIP / TMORT.PRG
Encoding:
Text File  |  1993-04-12  |  4.4 KB  |  135 lines
  1. program TMort;  {The Mortgage Analyzer}
  2.    uses crt, dos;
  3.  
  4. const
  5.    TermString  = 'months';                              {Mod. #1}
  6.    NumPayPerYr = 12;                                    {Mod. #2}
  7.  
  8. type
  9.    KeyListType = string[4];
  10.  
  11. var
  12.    Principal, Payment, FirstPayment, InterestRate    : real;
  13.    Interest, Balance, IntFactor, Amortized           : real;
  14.    TotalPayments, TotalInterest, TotalAmort          : real;
  15.    TotalNumPay, Code, LineCount, PayNum, LinesToShow : integer;
  16.    CharFlag, Reply, Reply2                           : char;
  17.    WantToSeeIt                                       : boolean;
  18.  
  19. {$I GetKey.PSL}
  20. {$I GetNumI.PSL}
  21. {$I GetNumR.PSL}
  22. {$I LoanPay.PSL}
  23.  
  24. procedure Header;
  25.  
  26. begin
  27.    clrscr;
  28.    writeln('Mortgage - Analysis of a loan repayment');
  29.    writeln;
  30.    writeln('Principal', '=':8, Principal:11:2);
  31.    writeln('Interest rate', '=':4, InterestRate:11:2);
  32.    writeln('Regular payment =', FirstPayment:11:2);
  33.    writeln('Term in ', TermString, '=':3, TotalNumPay:8);
  34.    writeln;
  35.    write('Remaining':16, '---Interest Paid---':22);
  36.    writeln('-Amount Amortized-':22);
  37.    writeln('Paymt.', 'Balance':9, 'This time':13,
  38.            'To date':10, 'This time':13, 'To date':9)
  39. end;
  40.  
  41. BEGIN
  42.    clrscr;
  43.    writeln('Mortgage - Analysis of a loan repayment');
  44.    repeat
  45.       writeln;
  46.       writeln('Please enter the principal.');
  47.       GetNumR(Principal, CharFlag, Code)
  48.    until
  49.       (Principal > 0.0) and (Code = 0);
  50.    repeat
  51.       writeln;
  52.       writeln('Please enter the annual interest rate.');
  53.       GetNumR(InterestRate, CharFlag, Code)
  54.    until
  55.       (Code = 0) and (InterestRate > 0.0) and
  56.                      (InterestRate < 100.0);
  57.    repeat
  58.       writeln;
  59.       write('Please enter the length of the loan in ');
  60.       writeln(TermString, '.');
  61.       GetNumI(TotalNumPay, CharFlag, Code)
  62.    until
  63.       (Code = 0) and (TotalNumPay > 0) and (TotalNumPay < 2000);
  64.    Payment := LoanPay(Principal, InterestRate,
  65.                       TotalNumPay, NumPayPerYr);
  66.    writeln;
  67.    writeln('Regular payment is', Payment:11:2);
  68.    write('Do you want to override this (Y or N)? ');
  69.    GetKey('YyNn', Reply, Reply2);
  70.    writeln(Reply);
  71.    if (Reply = 'Y') or (Reply = 'y') then
  72.       begin
  73.          repeat
  74.             writeln;
  75.             writeln('Please enter the desired payment.');
  76.             GetNumR(Payment, CharFlag, Code)
  77.          until
  78.             (Code = 0) and (Payment > 0.0)
  79.       end;
  80.    Payment      := int(Payment * 100.0 + 0.5) / 100.0;
  81.    FirstPayment := Payment;
  82.    Header;
  83.    Balance       := int(Principal * 100.0 + 0.5) / 100.0;
  84.    IntFactor     := InterestRate / NumPayPerYr;
  85.    TotalPayments := 0.0;
  86.    TotalInterest := 0.0;
  87.    TotalAmort    := 0.0;
  88.    WantToSeeIt   := true;
  89.    LinesToShow   := 12;                                 {Mod. #3}
  90.    LineCount     := 0;
  91.    PayNum        := 0;
  92.    repeat
  93.       inc(PayNum);
  94.       Interest := int(Balance * IntFactor + 0.5) / 100.0;
  95.       if PayNum = TotalNumPay then
  96.          Payment := Balance + Interest;
  97.       Amortized := Payment - Interest;
  98.       Balance   := Balance - Amortized;
  99.       if Balance < 0.0 then
  100.          begin
  101.             Payment   := Payment + Balance;
  102.             Amortized := Amortized + Balance;
  103.             Balance   := 0.0
  104.          end;
  105.       TotalPayments := TotalPayments + Payment;
  106.       TotalInterest := TotalInterest + Interest;
  107.       TotalAmort    := TotalAmort + Amortized;
  108.       if WantToSeeIt then
  109.          begin
  110.             write(PayNum:4, Balance:12:2, Interest:11:2);
  111.             write(TotalInterest:11:2, Amortized:11:2);
  112.             writeln(TotalAmort:11:2);
  113.             inc(LineCount);
  114.             if LineCount = LinesToShow then
  115.                begin
  116.                   writeln;
  117.                   write('Press T for Totals');
  118.                   writeln(' or [Enter] for next screen.');
  119.                   GetKey('Tt' + chr(13), Reply, Reply2);
  120.                   if Reply in ['T', 't'] then
  121.                      WantToSeeIt := false;
  122.                   Header;
  123.                   LineCount := 0
  124.                end
  125.          end
  126.    until
  127.       (PayNum = TotalNumPay) or (Balance = 0.0);
  128.    writeln;
  129.    writeln('Last payment   =', Payment:11:2);
  130.    writeln('Total payments =', TotalPayments:11:2);
  131.    writeln('Total number of payments =', PayNum:5);
  132.    writeln('Ratio of total payments to principal =',
  133.             TotalPayments / Principal:8:4)
  134. END.
  135.