home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l5p140 < prev    next >
Text File  |  1990-07-15  |  3KB  |  69 lines

  1. \      ╔════════════════════════════════════════════════════╗
  2. \      ║ Lesson 5 Part 140  F-PC 3.5 Tutorial by Jack Brown ║
  3. \      ╚════════════════════════════════════════════════════╝
  4.  
  5. \ Part five of CHKBOOK.SEQ
  6.  
  7. /* ************************************************************ */
  8. /*                                                              */
  9. /* Function: TOT_DEPOSIT   Total deposits this session          */
  10. /*                                                              */
  11. /* Date: July 25, 1988                                          */
  12. /*                                                              */
  13. /* Interface:   TOT_DEPOSIT ( -- )                              */
  14. /*                                                              */
  15. /* ************************************************************ */
  16.  
  17. : TOT_DEPOSIT ( -- )
  18.         70 CLR_HBAR
  19.         DEP_COUNT @ 0=
  20.         IF
  21.         ." There have been no deposits so far this session "
  22.         ." so the total is: "
  23.         ELSE DEP_COUNT @ 1 =
  24.              IF
  25.              ." Only one deposite has been made so far this session "
  26.              ." for a total of: "
  27.              ELSE
  28.             ." There were " DEP_COUNT @ .
  29.             ." deposits made so far this session "
  30.             ." that total: "
  31.             THEN
  32.        THEN
  33.        DEP_DOLLARS @ DEP_CENTS @ $XX.XX CR
  34.        70 HBAR ;
  35.  
  36. /* ************************************************************ */
  37. /* Function: AVERAGE   Reports average check written this       */
  38. /*                     session                                  */
  39. /* Date: July 25, 1988                                          */
  40. /*                                                              */
  41. /* Interface:   AVERAGE ( -- )                                  */
  42. /*                                                              */
  43. /* ************************************************************ */
  44.  
  45. CREATE MILLS 4 ALLOT
  46. VARIABLE ADOLLARS
  47. VARIABLE ACENTS
  48.  
  49. : AVERAGE ( -- )
  50.         CHK_COUNT @ 0=
  51.         IF
  52.         50 CLR_HBAR
  53.         ." You have not written any checks this session." CR
  54.         50 HBAR
  55.         ELSE
  56.         CHK_DOLLARS @ 1000 UM*
  57.         CHK_CENTS @ 10 * 0 D+
  58.         CHK_COUNT @ 0 D/
  59.         5 0 D+  10 0 D/
  60.         OVER OVER 100 0 D/ DROP ADOLLARS !
  61.         100 0 DMOD DROP ACENTS !
  62.         60 CLR_HBAR
  63.         ." For this session the average check written was: "
  64.         ADOLLARS @ ACENTS @ $XX.XX CR
  65.         60 HBAR
  66.         THEN ;
  67.  
  68.  
  69.