home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PAS_ENG.ZIP / PLOT.LIB < prev    next >
Encoding:
Text File  |  1985-07-18  |  3.0 KB  |  147 lines
  1.  
  2. procedure plot(  { with arrays }
  3.   x,  { as independant variable }
  4.   y,  { as dependant variable }
  5.   ycalc  { as fitted curve }
  6.   : ary;
  7.  { and } m : integer { number of points });
  8.  
  9. { plot y and ycalc as a function of x for m points }
  10. { if m is negative, only x and y are plotted }
  11.  
  12. const blank = ' ';
  13.  linel = 51;
  14.  
  15. var
  16.  ylabel  : array[1..6] of real;
  17.  out  : array[1..linel] of char;
  18.  lines,i,j,jp,l,n: integer;
  19.  iskip,yonly : boolean;
  20.  
  21.  xlow,xhigh,xnext,xlabel,xscale,signxs,
  22.  ymin,ymax,change,yscale,ys10  : real;
  23.  
  24. function pscale(p: real): integer;
  25. begin
  26.   pscale:=trunc((p-ymin)/yscale+1)
  27. end; { pscale}
  28.  
  29. procedure outlin(xname: real);
  30. { output a line }
  31.  
  32. var i,max : integer;
  33.  
  34. begin
  35.   write(xname:8:2,blank); { line label }
  36.   max:=linel+1;
  37.   repeat  { skip blanks on end of line }
  38.     max:=max-1
  39.   until (out[max]<>blank) or (max=1);
  40.   for i:=1 to max do
  41.     write(out[i]);
  42.   writeln;
  43.   for i:=1 to max do
  44.     out[i]:=blank { blank next line }
  45. end; { outlin}
  46.  
  47. procedure setup(index: integer);
  48. { setup the plus and asterisk for printing }
  49.  
  50. const star = '*';
  51.  plus = '+';
  52.  
  53. var i    : integer;
  54.  
  55. begin
  56.   i:=pscale(y[index]);
  57.   out[i]:=plus;
  58.   if not yonly then
  59.     begin  { add ycalc too }
  60.       i:=pscale(ycalc[index]);
  61.       out[i]:=star
  62.     end
  63. end;  { setup }
  64.  
  65.  
  66. begin  { body of plot }
  67.   if m>0 then  { plot y and ycalc vs x }
  68.     begin
  69.       n:=m;
  70.       yonly:=false
  71.     end
  72.   else  { plot only y vs x }
  73.     begin
  74.       n:=-m;
  75.       yonly:=true
  76.     end;
  77.   { space out alternate lines }
  78.   lines:=2*(n-1)+1;
  79.   writeln;
  80.   xlow:=x[1];
  81.   xhigh:=x[n];
  82.   ymax:=y[1];
  83.   ymin:=ymax;
  84.   xscale:=(xhigh-xlow)/(lines-1);
  85.   signxs:=1.0;
  86.   if xscale<0.0 then signxs:=-1.0;
  87.   for i:=1 to n do
  88.     begin
  89.       if y[i]<ymin then ymin:=y[i];
  90.       if y[i]>ymax then ymax:=y[i];
  91.       if not yonly then
  92.  begin
  93.    if ycalc[i]<ymin then ymin:=ycalc[i];
  94.    if ycalc[i]>ymax then ymax:=ycalc[i]
  95.  end { if yonly }
  96.   end;
  97.   yscale:=(ymax-ymin)/(linel-1);
  98.   ys10:=yscale*10;
  99.   ylabel[1]:=ymin; { y axis }
  100.   for i:=1 to 4 do
  101.     ylabel[i+1]:=ylabel[i]+ys10;
  102.   ylabel[6]:=ymax;
  103.   for i:=1 to linel do
  104.     out[i]:=blank; { blank line }
  105.   setup(1);
  106.   l:=1;
  107.   xlabel:=xlow;
  108.   iskip:=false;
  109.  
  110.   for i:=2 to lines do  { set up a line }
  111.     begin
  112.       xnext:=xlow+xscale*(i-1);
  113.       if iskip then writeln(' -')
  114.       else
  115.  begin
  116.    l:=l+1;
  117.    while
  118.      (x[l]-(xnext-0.5*xscale))*signxs<=0.0 do
  119.        begin
  120.   setup(l); { setup print line }
  121.   l:=l+1
  122.     end;  { while }
  123.  outlin(xlabel); { print a line }
  124.  for j:=1 to linel do
  125.    out[j]:=blank  { blank line }
  126.       end;  { if skip }
  127.     if (x[l]-(xnext+0.5*xscale))*signxs>0.0 then iskip:=true
  128.       else
  129.  begin
  130.    iskip:=false;
  131.    xlabel:=xnext;
  132.    setup(l)  { setup print line }
  133.  end
  134.     end;  { for-loop }
  135.   outlin(xhigh); { last line }
  136.   write('    ');
  137.   for i:=1 to 6 do
  138.     write('     ^    ');
  139.   writeln;
  140.   write('   ');
  141.   for i:=1 to 6 do
  142.     write(ylabel[i]:9:1,blank);
  143.   writeln;
  144.   writeln
  145. end;   { PLOT }
  146.  
  147.