home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / p2_14dc.seq < prev    next >
Encoding:
Text File  |  1990-03-30  |  1.7 KB  |  66 lines
  1. \ CUBICAL AND SPHERICAL PROGRAMS FOR P1.14
  2. \ Author: Dickson Cheng  03/30/90 19:59:04.32
  3.  
  4.  
  5. \ CUBICAL PROGRAM
  6.  
  7. : SIDE         ( l w h -- side )
  8.         4 * -ROT
  9.         4 * -ROT
  10.         4 * -ROT
  11.         + +      ;
  12.  
  13. : AREA         ( l w h -- area )
  14.         OVER OVER * -ROT        ( l w h -- l w*h w h )
  15.         3 PICK * ROT +          ( l w*h w h -- l w w*h+h*l )
  16.         SWAP ROT * + 2 * ;
  17.  
  18. : VOLUME       ( l w h -- vol )
  19.         * * ;
  20.  
  21. : .HEADING-C   ( -- )
  22.   CR CR 10 SPACES ." SIDE" 4 SPACES ." SURFACE AREA" 6 SPACES   ." VOLUME"
  23.      CR 10 SPACES ." feet" 4 SPACES ." square feet " 4 SPACES ." cubic feet"
  24.      CR 10 SPACES ." ====" 4 SPACES ." ============" 4 SPACES ." ==========" ;
  25.  
  26. : CUBICAL       ( l w h -- )
  27.         .HEADING-C
  28.      CR 10 SPACES 3DUP SIDE 4 .R
  29.         4  SPACES 3DUP AREA 8 .R 4 SPACES
  30.         4  SPACES    VOLUME 7 .R 5 SPACES ;
  31.  
  32. \ End of CUBICAL program
  33.  
  34.  
  35.  
  36. \ SPHERICAL PROGRAM
  37.  
  38. : .HEADING-S    ( -- )
  39.   CR CR 10 SPACES ." RADIUS" 4 SPACES ." SURFACE AREA" 6 SPACES   ." VOLUME"
  40.      CR 11 SPACES  ." feet " 4 SPACES ." square feet " 4 SPACES ." cubic feet"
  41.      CR 10 SPACES ." ======" 4 SPACES ." ============" 4 SPACES ." ==========" ;
  42.  
  43. : *PI           ( n n*pi)
  44.         355 113 */ ;
  45.  
  46. : V             ( r -- v )
  47.         DUP DUP 3 / * * 4 * *PI ;
  48.  
  49. : S             ( r -- s )
  50.         DUP * *PI 4 * ;
  51.  
  52. : SPHERICAL     ( r -- )
  53.         .HEADING-S
  54.      CR DUP 10 SPACES   5 .R   SPACE
  55.         DUP 4  SPACES S 9 .R 3 SPACES
  56.             4  SPACES V 8 .R 3 SPACES ;
  57.  
  58. \ End of SPHRICAL program
  59. : MESSAGE       ( -- )
  60.         DARK CR ." To run CUBICAL type l w h CUBICAL"
  61.              CR ." To run SPHERICAL type r SPHERICAL" ;
  62.  
  63. MESSAGE
  64.  
  65.  
  66.