home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / p3_24dc.seq < prev    next >
Encoding:
Text File  |  1990-04-05  |  1.5 KB  |  60 lines
  1. \ Problem 3.24 by Dickson Cheng  04/05/90 20:15:10.57
  2.  
  3.  
  4. \ 1. RUBOUT doesn't work, therefore users could not recognize the digit is
  5. \    being delete.
  6. \ 2. Input data and the final values can not exist the singed integer limit
  7. \    otherwise will cause error.
  8.  
  9.  
  10.  
  11.  
  12. \ (IN) leaves a true flag if a < x < b , otherwise false.
  13. : (IN)          ( x a b -- flag )
  14.         OVER 1 PICK > IF SWAP THEN
  15.         -ROT OVER < -ROT > AND ;
  16.  
  17. \ [IN] leaves a true flag if a <= x <= b
  18. : [IN]          ( x a b -- flag )
  19.         1+ SWAP 1- SWAP (IN) ;
  20.  
  21. : DIGIT?        ( n -- flag )
  22.         48 ( ASCII 0 ) 57 ( ASCII 9 ) [IN] ;
  23.  
  24. : RUBOUT        ( -- )
  25.         8 EMIT SPACE 8 EMIT ;
  26.  
  27. : -DIGIT        ( n -- n/10 )
  28.         10 / ;
  29.  
  30. : +DIGIT        ( n c -- 10n+c-48 )
  31.         48 - SWAP 10 * + ;
  32.  
  33. : #IN           ( -- n )
  34.       0 BEGIN KEY
  35.         DUP 13 ( enter ) =
  36.         IF DROP EXIT THEN
  37.         DUP 8 ( backspace ) =
  38.         IF DROP RUBOUT -DIGIT
  39.         ELSE DUP DIGIT?
  40.              IF  DUP EMIT
  41.                  +DIGIT
  42.              ELSE DROP
  43.                   7 ( bell ) EMIT
  44.              THEN
  45.         THEN
  46.         AGAIN ;
  47.  
  48. : GETL  ( -- l ) CR ." Enter tank length " #IN ;
  49. : GETW  ( -- w ) CR ." Enter tank width  " #IN ;
  50. : GETH  ( -- h ) CR ." Enter tank height " #IN ;
  51. : .VOLUME ( l w h -- ) * * CR ." Volume " . ." cubic feet." ;
  52. : .AREA         ( l w h -- )
  53.         3DUP 5 ROLL * 2* -ROT * 2* + -ROT * 2* +
  54.         CR ." Surface area " . ." square feet." ;
  55.  
  56. : TANK          ( -- )
  57.         GETL GETW GETH
  58.         3DUP .VOLUME .AREA ;
  59.  
  60.