home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / program / compiler / elan1v5 / intgraph / waves.e < prev   
Text File  |  1989-03-10  |  4KB  |  151 lines
  1.  
  2. PROC graphics (REAL CONST xmin, xmax, INT CONST steps,
  3.                REAL PROC (REAL CONST) f):
  4.    REAL VAR x, delta x :: (xmax - xmin) / real (steps - 1);
  5.    move (graphics x limit DIV 3, graphics y limit DIV 2);
  6.    put ("Computing...");
  7.    determine minimal and maximal function values;
  8.    page;
  9.    fix viewport and world;
  10.    draw the axis x with annotation;
  11.    draw the axis y with annotation;
  12.    draw the graphics.
  13.  
  14. determine minimal and maximal function values:
  15.    x := xmin;
  16.    REAL VAR ymin :: f (x), ymax :: f (x);
  17.    WHILE x <= xmax
  18.    REP
  19.      x INCR delta x;
  20.      IF ymax < f (x) THEN ymax := f (x)
  21.      ELIF ymin > f (x) THEN ymin := f (x)
  22.      FI
  23.    ENDREP.
  24.  
  25. fix viewport and world:
  26.    INT CONST xvmin :: 10 * character width,
  27.              xvmax :: graphics x limit - 10 * character width,
  28.              yvmin :: graphics y limit - 2 * line height,
  29.              yvmax :: 2 * line height;
  30.    REAL VAR sx :: real (xvmax - xvmin) / (xmax - xmin),
  31.             sy :: real (yvmax - yvmin) / (ymax - ymin),
  32.             cx :: real (xvmin) - sx * xmin,
  33.             cy :: real (yvmin) - sy * ymin.
  34.  
  35. draw the axis x with annotation:
  36.    INT CONST y0 :: round (cy),
  37.              xvmid :: xvmin + (xvmax - xvmin) DIV 2;
  38.    move (xvmin - 8 * character width, y0 - line height DIV 3);
  39.    plot text (text (xmin, 7, 2));
  40.    move (xvmid - 3 * character width DIV 2, y0 + line height DIV 3);
  41.    plot text (text (xmin + (xmax - xmin) / 2.0, 7, 2));
  42.    move (xvmax - 3 * character width DIV 2, y0 - line height DIV 3);
  43.    plot text (text (xmax, 7, 2));
  44.    move (xvmax, y0 - line height);
  45.    draw (xvmax, y0 + line height);
  46.    move (xvmid, y0 - line height);
  47.    draw (xvmid, y0 + line height);
  48.    move (xvmin, y0);
  49.    draw (xvmax, y0).
  50.  
  51. draw the axis y with annotation:
  52.    INT CONST x0 :: round (cx);
  53.    move (x0 - 5 * character width, yvmin + line height DIV 3);
  54.    plot text (text (ymin, 7, 2));
  55.    move (x0 - 5 * character width, yvmax - 4 * line height DIV 3);
  56.    plot text (text (ymax, 7, 2));
  57.    move (x0, yvmin);
  58.    draw (x0, yvmax).
  59.  
  60. draw the graphics:
  61.    x := xmin;
  62.    move (round (x * sx + cx), round (f (x) * sy + cy));
  63.    WHILE x <= xmax
  64.    REP
  65.      x INCR delta x;
  66.      draw (round (x * sx + cx), round (f (x) * sy + cy))
  67.    ENDREP.
  68. ENDPROC graphics;
  69.  
  70. REAL PROC square (REAL CONST x):
  71.   IF abs (x MOD (2.0 * pi)) <= pi
  72.   THEN 0.99
  73.   ELSE - 0.99
  74.   FI
  75. ENDPROC square;
  76.  
  77. REAL PROC saw (REAL CONST x):
  78.   REAL CONST xx :: abs (x MOD (2.0 * pi));
  79.   IF xx < 0.00000001
  80.   THEN - 0.99
  81.   ELSE - 0.99 + xx / pi
  82.   FI
  83. ENDPROC saw;
  84.  
  85. REAL PROC trapezoid (REAL CONST x):
  86.   REAL CONST xx :: abs (x MOD (2.0 * pi));
  87.   IF xx <= pi / 4.0
  88.   THEN xx * 4.0 / pi
  89.   ELIF xx <= 3.0 * pi / 4.0
  90.   THEN 0.99
  91.   ELIF xx <= 5.0 * pi / 4.0
  92.   THEN 0.99 - (xx - 3.0 * pi / 4.0) * 4.0 / pi
  93.   ELIF xx <= 7.0 * pi / 4.0
  94.   THEN - 0.99
  95.   ELSE - 0.99 + (xx - 7.0 * pi / 4.0) * 4.0 / pi
  96.   FI
  97. ENDPROC trapezoid;
  98.  
  99. REAL PROC zigzag (REAL CONST x):
  100.   (2.5 * sin (6.0 * x) - tan (x)) * (cos (3.0 * x) * trapezoid (4.0 * x))
  101. ENDPROC zigzag;
  102.  
  103. program:
  104.   REP
  105.     page;
  106.     put ("         W A V E S");
  107.     line;
  108.     put ("square - 1, saw - 2, trapezoid - 3, zigzag - 4, sine - 5");
  109.     line;
  110.     INT CONST select :: ask int ("Select one, please, or 0 to exit: ");
  111.     SELECT select OF
  112.     CASE 1: square wave
  113.     CASE 2: saw wave
  114.     CASE 3: trapezoid wave
  115.     CASE 4: zigzag wave
  116.     CASE 5: sine wave
  117.     OTHERWISE LEAVE program
  118.     ENDSELECT
  119.   ENDREP.
  120.  
  121. square wave:
  122.   enter graphics mode;
  123.   graphics (0.0, 4.0 * pi, 200, REAL PROC (REAL CONST) square);
  124.   wait for confirmation (2 * graphics x limit DIV 3, 1);
  125.   leave graphics mode.
  126.  
  127. saw wave:
  128.   enter graphics mode;
  129.   graphics (0.0, 4.0 * pi, 200, REAL PROC (REAL CONST) saw);
  130.   wait for confirmation (2 * graphics x limit DIV 3, 1);
  131.   leave graphics mode.
  132.  
  133. trapezoid wave:
  134.   enter graphics mode;
  135.   graphics (0.0, 4.0 * pi, 200, REAL PROC (REAL CONST) trapezoid);
  136.   wait for confirmation (2 * graphics x limit DIV 3, 1);
  137.   leave graphics mode.
  138.  
  139. zigzag wave:
  140.   enter graphics mode;
  141.   graphics (0.0, 4.0 * pi, 200, REAL PROC (REAL CONST) zigzag);
  142.   wait for confirmation (2 * graphics x limit DIV 3, 1);
  143.   leave graphics mode.
  144.  
  145. sine wave:
  146.   enter graphics mode;
  147.   graphics (0.0, 4.0 * pi, 200, REAL PROC (REAL CONST) sin);
  148.   wait for confirmation (2 * graphics x limit DIV 3, 1);
  149.   leave graphics mode.
  150.  
  151. ə