home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / SCRSHO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.5 KB  |  64 lines
  1. PROCEDURE scrsho;
  2. (* Programs using routine SCRSHO must externally define a
  3. function fx(x:real):real which is to be plotted. *)
  4. LABEL 1,99;
  5. CONST
  6.    iscr=60;
  7.    jscr=21;
  8.    blank=' ';
  9.    zero='-';
  10.    yy='l';
  11.    xx='-';
  12.    ff='x';
  13. VAR
  14.    jz,j,i: integer;
  15.    ysml,ybig,x2,x1,x,dyj,dx: real;
  16.    y: ARRAY [1..iscr] OF real;
  17.    scr: ARRAY [1..iscr,1..jscr] OF char;
  18. BEGIN
  19. 1:   writeln('Enter x1 x2 (x1=x2 to stop): '); readln(x1,x2);
  20.    IF (x1 = x2) THEN GOTO 99;
  21.    FOR j := 1 TO jscr DO BEGIN
  22.       scr[1,j] := yy;
  23.       scr[iscr,j] := yy
  24.    END;
  25.    FOR i := 2 TO iscr-1 DO BEGIN
  26.       scr[i,1] := xx;
  27.       scr[i,jscr] := xx;
  28.       FOR j := 2 TO jscr-1 DO BEGIN
  29.          scr[i,j] := blank
  30.       END
  31.    END;
  32.    dx := (x2-x1)/(iscr-1);
  33.    x := x1;
  34.    ybig := 0.0;
  35.    ysml := ybig;
  36.    FOR i := 1 TO iscr DO BEGIN
  37.       y[i] := fx(x);
  38.       IF (y[i] < ysml) THEN  ysml := y[i];
  39.       IF (y[i] > ybig) THEN  ybig := y[i];
  40.       x := x+dx
  41.    END;
  42.    IF (ybig = ysml) THEN  ybig := ysml+1.0;
  43.    dyj := (jscr-1)/(ybig-ysml);
  44.    jz := 1-trunc(ysml*dyj);
  45.    FOR i := 1 TO iscr DO BEGIN
  46.       scr[i,jz] := zero;
  47.       j := 1+trunc((y[i]-ysml)*dyj);
  48.       scr[i,j] := ff
  49.    END;
  50.    write(' ',ybig:10:3,' ');
  51.    FOR i := 1 TO iscr DO write(scr[i,jscr]);
  52.    writeln;
  53.    FOR j := jscr-1 DOWNTO 2 DO BEGIN
  54.       write(' ':12);
  55.       FOR i := 1 TO iscr DO write(scr[i,j]);
  56.       writeln
  57.    END;
  58.    write(' ',ysml:10:3,' ');
  59.    FOR i := 1 TO iscr DO write(scr[i,1]);
  60.    writeln;
  61.    writeln(' ':8,x1:10:3,' ':44,x2:10:3);
  62.    GOTO 1;
  63. 99:   END;
  64.