home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Distributions / ucb / spencer_2bsd.tar.gz / 2bsd.tar / src / pascal / tests / t02.p < prev    next >
Text File  |  1980-02-17  |  3KB  |  180 lines
  1. program graph1(output);
  2. const
  3.     d = 0.0625;
  4.     s = 32;
  5.     h = 34;
  6.     c = 6.28318;
  7. var
  8.     x,y: real;
  9.     i,n: integer;
  10. procedure rdr(var f: text; var x: real);
  11. const
  12.     t48 = 281474976710656;
  13.     limit = 56294995342131;
  14.     z = 27;
  15.     lim1 = 322;
  16.     lim2 = -292;
  17. type
  18.     posint = 0..323;
  19. var
  20.     ch: char;
  21.     y: real;
  22.     a, i, e: integer;
  23.     s, ss: boolean;
  24.  
  25. function ten(e: posint): real;
  26. var
  27.     i: integer;
  28.     t: real;
  29. begin
  30.     i := 0;
  31.     t := 1.0;
  32.     repeat
  33.         if odd(e) then
  34.         case i of
  35.         0: t := t*1.0e1;
  36.         1: t := t*1.0e2;
  37.         2: t := t*1.0e4;
  38.         3: t := t*1.0e8;
  39.         4: t := t*1.0e16;
  40.         5: t := t*1.0e32;
  41.         6: t := t*1.0e64;
  42.         7: t := t*1.0e128;
  43.         8: t := t*1.0e256
  44.         end ;
  45.         e := e div 2;
  46.         i := i+1;
  47.     until e = 0;
  48.     ten := t
  49. end ;
  50.  
  51. begin
  52.     if eof(f) then
  53.     begin
  54.         message('**tried to read past eos/eof');
  55.         halt
  56.     end ;
  57.     while (f^ = ' ') and (not eof(f)) do
  58.         get(f);
  59.     if not eof(f) then
  60.     begin
  61.         ch := f^;
  62.         if ch = '-' then
  63.         begin
  64.             s := true;
  65.             get(f);
  66.             ch := f^;
  67.         end else
  68.         begin
  69.             s := false;
  70.             if ch = '+' then
  71.             begin
  72.                 get(f);
  73.                 ch := f^;
  74.             end
  75.         end ;
  76.         if not (ch in ['0'..'9']) then
  77.         begin
  78.             message('**digit expected');
  79.             halt
  80.         end ;
  81.         a := 0;
  82.         e := 0;
  83.         repeat
  84.             if a < limit then
  85.                 a := 10*a + ord(ch)-z else
  86.                 e := e+1;
  87.             get(f);
  88.             ch := f^;
  89.         until not (ch in ['0'..'9']);
  90.         if ch = '.' then
  91.         begin
  92.             get(f);
  93.             ch := f^;
  94.             while ch in ['0'..'9'] do
  95.             begin
  96.                 if a < limit then
  97.                 begin
  98.                     a := 10*a+ord(ch)-z;
  99.                     e := e-1;
  100.                 end ;
  101.                 get(f);
  102.                 ch := f^;
  103.             end
  104.         end;
  105.         if ch = 'e' then
  106.         begin
  107.             get(f);
  108.             ch := f^;
  109.             i := 0;
  110.             if ch = '-' then
  111.             begin
  112.                 ss := true;
  113.                 get(f);
  114.                 ch := f^;
  115.             end else
  116.             begin
  117.                 ss := false;
  118.                 if ch = '+' then
  119.                 begin
  120.                     get(f);
  121.                     ch := f^;
  122.                 end
  123.             end;
  124.             if ch in ['0'..'9'] then
  125.             begin
  126.                 i := ord(ch)-z;
  127.                 get(f);
  128.                 ch := f^;
  129.                 while ch in ['0'..'9'] do
  130.                 begin
  131.                     if i < limit then
  132.                         i := 10*i + ord(ch)-z;
  133.                     get(f);
  134.                     ch := f^;
  135.                 end
  136.             end else
  137.             begin
  138.                 message(' digit expected');
  139.                 halt
  140.             end ;
  141.             if ss then
  142.                 e := e-i else
  143.                 e := e+i;
  144.         end;
  145.         if e < lim2 then
  146.         begin
  147.             a := 0;
  148.             e := 0;
  149.         end else
  150.         if e > lim1 then
  151.         begin
  152.             message('**number too large');
  153.             halt
  154.         end;
  155.         if a >= t48 then
  156.             y := ((a+1) div 2) * 2.0 else
  157.             y := a;
  158.         if s then
  159.             y := -y;
  160.         if e < 0 then
  161.             x := y/ten(-e) else
  162.         if e <> 0 then
  163.             x := y*ten(e) else
  164.             x := y;
  165.     end;
  166. end;
  167. begin
  168.     for i := 0 to lim do
  169.     begin
  170.         x := d*i;
  171.         y := exp(-x)*sin(c*x);
  172.         n := round(s*y) + h;
  173.         repeat
  174.             write(blank);
  175.             n := n-1;
  176.         until n=0;
  177.         write(aster)
  178.     end
  179. end.
  180.