home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l5p120 < prev    next >
Encoding:
Text File  |  1990-07-15  |  3.3 KB  |  80 lines
  1. \      ╔════════════════════════════════════════════════════╗
  2. \      ║ Lesson 5 Part 120  F-PC 3.5 Tutorial by Jack Brown ║
  3. \      ╚════════════════════════════════════════════════════╝
  4.  
  5. \ Part three of CHKBOOK.SEQ
  6.  
  7. /* ************************************************************ */
  8. /*                                                              */
  9. /* Function:    SUB_FROM_BAL - subtract dollars, cents amount   */
  10. /*                             from balance.                    */
  11. /*                                                              */
  12. /* Date: July 22, 1988                                          */
  13. /*                                                              */
  14. /* Interface:   SUB_FROM_BAL ( dollars cents --  flag)          */
  15. /*               dollars : dollar amount to be subtracted       */
  16. /*               cents   : cents amount to be subtracted        */
  17. /*               flag = false if illeagal transaction.          */
  18. /*                                                              */
  19. /* ************************************************************ */
  20.  
  21. VARIABLE D
  22. VARIABLE C
  23.  
  24. : SUB_FROM_BAL ( dollars cents --  flag )
  25.         BAL_DOLLARS @ D !
  26.         BAL_CENTS   @ C !
  27.         DUP C @ >
  28.         IF  -1 D +! 100 C +! THEN
  29.         NEGATE C +! NEGATE D +!
  30.         D @ 0 <
  31.         IF   60 CLR_HBAR
  32.              7 DUP DUP EMIT EMIT EMIT
  33.             ." You are trying to overdraw your account. You must" CR
  34.             ." first make a deposit before trying to write a cheque" CR
  35.             ." this large." CR
  36.             60 HBAR
  37.             FALSE
  38.         ELSE  C @ BAL_CENTS ! D @ BAL_DOLLARS ! TRUE
  39.         THEN  ;
  40.  
  41. : $XX.XX  ( dollars cents  -- )
  42.        0  <# # # ASCII . HOLD DROP #S ASCII $ HOLD #> TYPE ;
  43.  
  44. /* ************************************************************ */
  45. /*                                                              */
  46. /* Function     WRITE_A_CHECK - Calculate new balance           */
  47. /*                              after check is written          */
  48. /*                                                              */
  49. /* Date: July 25, 1988                                          */
  50. /*                                                              */
  51. /* Interface:   WRITE_A_CHECK ( -- )                            */
  52. /*                                                              */
  53. /*                                                              */
  54. /* Notes: Calls SUB_FROM_BAL to perform the fixed point         */
  55. /*        calculations.                                         */
  56. /*                                                              */
  57. /* ************************************************************ */
  58.  
  59. : WRITE_A_CHECK ( -- )
  60.         40 CLR_HBAR
  61.         ." Enter the amount of the check:" CR
  62.         40 HBAR
  63.         GET_DOLLARS GET_CENTS ROUND
  64.         OVER OVER
  65.         TR_CENTS ! TR_DOLLARS !
  66.         40 HBAR
  67.         SUB_FROM_BAL
  68.         IF  1 CHK_COUNT +!
  69.             TR_DOLLARS @ CHK_DOLLARS @ +
  70.             TR_CENTS   @ CHK_CENTS   @ +
  71.             ROUND  
  72.             CHK_CENTS ! CHK_DOLLARS !
  73.            ." After writing a check for: " 
  74.            TR_DOLLARS @ TR_CENTS @ $XX.XX CR           
  75.            ." your new balance comes to: "
  76.            BAL_DOLLARS @ BAL_CENTS @ $XX.XX CR
  77.            40 HBAR
  78.        THEN ;
  79.  
  80.