home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / elan / demo / calc.eln next >
Text File  |  1987-08-18  |  4KB  |  220 lines
  1.  
  2. PROC push (REAL CONST r):
  3.   FOR i FROM stack max DOWNTO 2
  4.   REP stack [i] := stack [i - 1]
  5.   ENDREP;
  6.   stack [1] := r
  7. ENDPROC push;
  8.  
  9. REAL PROC pop:
  10.   REAL CONST top :: stack [1];
  11.   FOR i FROM 1 UPTO stack max - 1
  12.   REP stack [i] := stack [i + 1]
  13.   ENDREP;
  14.   stack [stack max] := 0.0;
  15.   top
  16. ENDPROC pop;
  17.  
  18. program:
  19.   init calculator;
  20.   REP
  21.     get next command;
  22.     process command
  23.   UNTIL end
  24.   ENDREP;
  25.   page.
  26.  
  27.   init calculator:
  28.     tell name;
  29.     give menu;
  30.     give command prompt;
  31.     init stack.
  32.   
  33.     tell name:
  34.       to header position;
  35.       put ("Pocket calculator").
  36.     
  37.       to header position:
  38.         cursor (30, 1).
  39.       
  40.     give menu:
  41.       to menu position;
  42.       put ("    Commands:");
  43.       line (2);
  44.       put ("<REAL denotation>");
  45.       line;
  46.       put ("+ - * /");
  47.       line;
  48.       put ("i       invert x");
  49.       line;
  50.       put ("x       x <--> y");
  51.       line;
  52.       put ("d       y <-x");
  53.       line;
  54.       put ("^       x ** y");
  55.       line;
  56.       put ("q       sqrt(x)");
  57.       line;
  58.       put ("l       ln(x)");
  59.       line;
  60.       put ("e       exp(x)");
  61.       line;
  62.       put ("p       pi");
  63.       line;
  64.       put ("s       sin(x)");
  65.       line;
  66.       put ("c       cos(x)");
  67.       line;
  68.       put ("a       arctan(x)");
  69.       line;
  70.       put ("m       max real");
  71.       line (2);
  72.       put ("$       end").
  73.     
  74.       to menu position:
  75.         cursor (1, 3).
  76.       
  77.     give command prompt:
  78.       cursor (33, 12);
  79.       put ("Command:").
  80.     
  81.     init stack:
  82.       LET stack max = 4;
  83.       ROW stack max REAL VAR stack;
  84.       INT VAR i;
  85.       FOR i FROM 1 UPTO stack max
  86.       REP stack [i] := 0.0
  87.       ENDREP;
  88.       show stack.
  89.     
  90.       show stack:
  91.         FOR i FROM stack max DOWNTO 1
  92.         REP
  93.           cursor (40, 11 - i);
  94.           put (""2"");
  95.           IF i = 2
  96.           THEN put ("y ")
  97.           ELIF i = 1
  98.           THEN put ("x ")
  99.           ELSE put ("  ")
  100.           FI;
  101.           put (stack [i]);
  102.           line
  103.         ENDREP.
  104.       
  105.   get next command:
  106.     TEXT VAR command;
  107.     to command position;
  108.     get (command).
  109.   
  110.     to command position:
  111.       cursor (44, 12);
  112.       put (""2"").
  113.     
  114.   process command:
  115.     IF NOT end
  116.     THEN
  117.       TEXT CONST h :: HEAD command;
  118.       IF digit (h) >= 0
  119.       THEN process numeral
  120.       ELSE
  121.         REAL CONST top :: pop;
  122.         SELECT pos ("+-*/ixd^qlepscam", h) OF
  123.           CASE 1: add
  124.           CASE 2: subtract
  125.           CASE 3: multiply
  126.           CASE 4: divide
  127.           CASE 5: invert
  128.           CASE 6: exchange
  129.           CASE 7: double top
  130.           CASE 8: power
  131.           CASE 9: square root
  132.           CASE 10: logarithm
  133.           CASE 11: exponent
  134.           CASE 12: load pi
  135.           CASE 13: sinus
  136.           CASE 14: cosinus
  137.           CASE 15: arcus tangent
  138.           CASE 16: load max real
  139.           OTHERWISE
  140.             push (top);
  141.             illegal command
  142.         ENDSELECT
  143.       FI;
  144.       show stack
  145.     FI.
  146.   
  147.     end:
  148.       HEAD command = "$".
  149.     
  150.     process numeral:
  151.       REAL VAR r :: real (command);
  152.       IF last conversion ok
  153.       THEN push (r)
  154.       ELSE illegal number
  155.       FI.
  156.     
  157.       illegal number:
  158.         to command position;
  159.         put ("Illegal number!");
  160.         sleep (3).
  161.       
  162.     add:
  163.       push (top + pop).
  164.     
  165.     subtract:
  166.       push (pop - top).
  167.     
  168.     multiply:
  169.       push (pop * top).
  170.     
  171.     divide:
  172.       push (pop / top).
  173.     
  174.     invert:
  175.       push (- top).
  176.     
  177.     exchange:
  178.       REAL CONST temp :: pop;
  179.       push (top);
  180.       push (temp).
  181.     
  182.     double top:
  183.       push (top);
  184.       push (top).
  185.     
  186.     power:
  187.       push (top ** pop).
  188.     
  189.     square root:
  190.       push (sqrt (top)).
  191.     
  192.     logarithm:
  193.       push (ln (top)).
  194.     
  195.     exponent:
  196.       push (exp (top)).
  197.     
  198.     load pi:
  199.       push (top);
  200.       push (pi).
  201.     
  202.     sinus:
  203.       push (sin (top)).
  204.     
  205.     cosinus:
  206.       push (cos (top)).
  207.     
  208.     arcus tangent:
  209.       push (arctan (top)).
  210.     
  211.     load max real:
  212.       push (top);
  213.       push (maxreal).
  214.     
  215.     illegal command:
  216.       to command position;
  217.       put ("Illegal command!");
  218.       sleep (3).
  219.     
  220.