home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / math / rcdsplay / iofuncs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-30  |  24.1 KB  |  634 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
  2. {$M 16384,0,655360}
  3. {**********************************************************************
  4.  Unit   : IOFUNCS
  5.  Version: 1.8
  6.  Purpose: This unit contains useful procedures to simplify IO tasks.
  7.  Author : Translated form those of Mike Riebe (MISFUNCS, version 3.3)
  8.           by Roger Carlson.
  9.  Changes: 5/17/90 (RJC,1.1) - Added the procedures of version 1.7 of
  10.             RCGRAF.
  11.           5/31/90 (RJC,1,2) - Removed the RLTOSTR, DBLTOSTR, LNGTOSTR,
  12.             and INTTOSTR procedures which are more easily implemented
  13.             by Turbo Pascal's STR procedure.
  14.           6/9/90 (RJC,1.3) - Added graphics mode rdstr procedures and
  15.             INTTOSTR.
  16.           2/15/91 (RJC,1.4) - Added line feed at end of some procedures.
  17.           3/28/91 (RJC,1.5) - Added RLTOSTR funciton and the graphics
  18.             mode GRDINT procedure.
  19.           5/3/91 (RJC,1.6) - Added graphics mode GRDDBL and GRDREAL
  20.             procedures.
  21.           5/11/91 (RJC,1.7) - Added the DOS shell command DOS_CMD.
  22.           5/18/91 (RJC,1.8) - Added LNGTOSTR function and RDLONGLN
  23.             procedure.
  24. ***********************************************************************}
  25. UNIT IOFUNCS;
  26.  
  27. INTERFACE
  28.  
  29. TYPE STR160 = STRING[160];  STR80  = STRING[80];  STR40  = STRING[40];
  30.      STR30  = STRING[30];   STR20  = STRING[20];  STR3   = STRING[3];
  31.  
  32. PROCEDURE rdrealn(VAR window : TEXT; VAR value : REAL);
  33. PROCEDURE rddbln(VAR window : TEXT; VAR value : DOUBLE);
  34. PROCEDURE rdintln(VAR window : TEXT; VAR value : INTEGER);
  35. PROCEDURE RDLONGLN(VAR WINDOW:TEXT; VAR VALUE:LONGINT);
  36. PROCEDURE rdstr160(VAR window : TEXT; VAR value : STR160);
  37. PROCEDURE rdstr80(VAR WINDOW:TEXT; VAR value:STR80);
  38. PROCEDURE rdstr40(VAR WINDOW:TEXT; VAR value:STR40);
  39. PROCEDURE rdstr30(VAR WINDOW:TEXT; VAR value:STR30);
  40. PROCEDURE rdstr20(VAR window : TEXT; VAR value : STR20);
  41. PROCEDURE rdstr3(VAR window : TEXT; VAR value : STR3);
  42. PROCEDURE rdcharln(VAR window : TEXT; VAR value : CHAR);
  43. PROCEDURE GRDSTR160(VAR VALUE:STR160);
  44. PROCEDURE GRDSTR80(VAR VALUE:STR80);
  45. PROCEDURE GRDSTR40(VAR VALUE:STR40);
  46. PROCEDURE GRDSTR30(VAR VALUE:STR30);
  47. PROCEDURE GRDSTR20(VAR VALUE:STR20);
  48. PROCEDURE GRDSTR3(VAR VALUE:STR3);
  49. PROCEDURE GRDCHAR(VAR VALUE:CHAR);
  50. PROCEDURE GRDINT(VAR VALUE:INTEGER);
  51. PROCEDURE GRDDBL(VAR VALUE:DOUBLE);
  52. PROCEDURE GRDREAL(VAR VALUE:REAL);
  53. FUNCTION CALCINCR(INCR:DOUBLE):DOUBLE;
  54.     {This function returns the largest power of 1, 2, or 5 <= INCR and can be
  55.      used to calculate round number intervals for labeling of plots.  INCR
  56.      should be a positive number.}
  57. PROCEDURE ENGNOT(NUMBER:DOUBLE; VAR MANTISSA:DOUBLE; VAR EXPONENT:LONGINT);
  58.     {This procedure calculates the engineering notation mantissa and exponent
  59.      for the number NUMBER.}
  60. FUNCTION NUMDEC(NUM:DOUBLE):INTEGER;
  61.     {Calculates the number of decimals in a number to an accuracy of about 1
  62.      part in 1E6}
  63. FUNCTION EXISTS(FILENAME:STR30):BOOLEAN;
  64. PROCEDURE BEEP(HZ:WORD);
  65. FUNCTION INTTOSTR(I:INTEGER):STR80; {Converts an integer to a string.}
  66. FUNCTION LNGTOSTR(I:LONGINT):STR80; {Converts a long integer to a string.}
  67. FUNCTION RLTOSTR(RL:REAL;WIDTH:INTEGER):STR80;
  68.   {Converts a real number to a string.}
  69. PROCEDURE DOS_CMD; {executes a dos command}
  70.  
  71.  
  72. IMPLEMENTATION
  73.  
  74. USES CRT, GRAPH, DOS, MATH;
  75.  
  76. {************************ PROCEDURE DOS_CMD **************************}
  77. PROCEDURE DOS_CMD;
  78. VAR NAME:STR80;
  79. BEGIN
  80.   CLRSCR;
  81.   WRITE('Command: '); RDSTR80(OUTPUT,NAME); WRITELN;
  82.   SWAPVECTORS; EXEC('C:\COMMAND.COM',CONCAT('/C ',NAME)); SWAPVECTORS;
  83.   IF DOSERROR<>0 THEN WRITELN('DOS ERROR # ',DOSERROR);
  84.   WRITE('Hit <ENTER> to continue.'); READLN;
  85. END;
  86.  
  87. {******************************************************************************
  88.   TITLE:    RDREALN(VAR WINDOW:TEXT; VAR VALUE : REAL);
  89.   FUNCTION: To provide a mechanism for reading real numbers from the keyboard
  90.             as well as provide for keeping the current value of the variable
  91.             to be read by inputing a carriage return.
  92.   INPUTS:   A string of digits including '+','-','.',and 'E' defining a real
  93.             value.
  94.   OUTPUTS:  A new value for a variable unless <CR> was the only character
  95.             in the input string.
  96.   AUTHOR:   M. Riebe  11/17/84
  97.   CHANGES:  12/06/84:  Fixed procedure for finding starting index so that only
  98.                        digits are valid.
  99.             5/15/85 MTR: Fixed correction procedure to allow backspaces.
  100.             6/20/85 RJC: Improved error correction.
  101.             10/1/85 MTR: Changed to use RDDBLN and convert to real.
  102.             10/30/85 RJC:Fixed so that value unchanged if return is entered.
  103.             4/8/90   RJC:Translated to Turbo Pascal.
  104. ******************************************************************************}
  105. PROCEDURE RDREALN;
  106. VAR DBLTEMP:DOUBLE;
  107. BEGIN DBLTEMP:=VALUE; RDDBLN(WINDOW,DBLTEMP); VALUE:=DBLTEMP; END;
  108.  
  109. {******************************************************************************
  110.   TITLE:    RDDBLN(VAR WINDOW:TEXT; VAR VALUE:DOUBLE)
  111.   VERSION:  1.1
  112.   FUNCTION: Input of double precision real numbers interactively from the
  113.             keyboard.
  114.   AUTHOR:   RJC 9/29/85
  115.   CHANGES:  (4/8/90, 1.1, RJC) - Translated to Turbo Pascal.  Modified to
  116.                prevent reading of spurious characters and backspacing before
  117.                the first character.
  118. ******************************************************************************}
  119. PROCEDURE RDDBLN;
  120. VAR
  121.   CH                 : CHAR;
  122.   I,J,K,L,M,N,POWVAL : INTEGER;
  123.   ASCII              : ARRAY[1..20] OF INTEGER;
  124.   NEG,POWNEG         : BOOLEAN;
  125. BEGIN {1}
  126.   NEG := FALSE;  POWNEG := FALSE;  POWVAL := 0;  I := 1;
  127.   REPEAT
  128.     REPEAT CH:=READKEY
  129.     UNTIL CH IN ['0'..'9','+','-','D','E','.',CHR(13),CHR(8)];
  130.     ASCII[I]:=ORD(CH);
  131.     IF (ASCII[I] = 8) THEN BEGIN
  132.       IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
  133.       IF I<=2 THEN I:=0 ELSE I:=I-2;
  134.       END
  135.     ELSE WRITE(WINDOW,CH);
  136.     I:=I+1;
  137.   UNTIL ORD(CH)=13;
  138.   I:=I-1;                   {leave index at last character}
  139.   IF ASCII[1]<>13 THEN BEGIN {2}
  140.       VALUE:=0; J:=0; K:=0;
  141.       REPEAT J:=J+1 UNTIL ASCII[J] IN [43,45..58];
  142.       REPEAT K:=K+1 UNTIL ASCII[K] IN [46,68,69,13];
  143.       CASE ASCII[J] OF
  144.          43 {+}: J:=J+1;
  145.          45 {-}: BEGIN NEG:=TRUE; J:=J+1; END;
  146.       END; {CASE}
  147.       FOR L:=J TO (K-1) DO VALUE:=VALUE+(ASCII[L]-48)*PWROF10(K-L-1);
  148.       IF ASCII[K]=46 THEN BEGIN {'.'}
  149.         M := K;
  150.         REPEAT M:= M + 1 UNTIL ASCII[M] IN [68,69,13];
  151.         FOR N:=K+1 TO M-1 DO VALUE:=VALUE+(ASCII[N]-48)/PWROF10(N-K);
  152.         K := M;
  153.         END; {IF}
  154.       IF ASCII[K] IN [68,69] THEN BEGIN {'D' or 'E'}
  155.         CASE ASCII[K+1] OF
  156.           43 {+}: K:=K+1;
  157.           45 {-}: BEGIN POWNEG:=TRUE; K:=K+1; END;
  158.         END; {CASE}
  159.         FOR N:=K+1 TO I-1 DO POWVAL:=POWVAL+
  160.                              (ASCII[N]-48)*ROUND(PWROF10(I-N-1));
  161.         END; {IF}
  162.       IF NEG THEN VALUE:=VALUE*(-1);
  163.       IF POWNEG THEN VALUE := VALUE/PWROF10(POWVAL)
  164.       ELSE VALUE := VALUE*PWROF10(POWVAL);
  165.     END;  {2}
  166.   WRITE(WINDOW,CHR($0A)); {line feed}
  167.   END; {1}
  168.  
  169. {******************************************************************************
  170.   TITLE:     rdintln(VAR WINDOW:TEXT; VAR VALUE:INTEGER);
  171.   FUNCTION:  To provide a mechanism for reading integers from the keyboard
  172.              while providing for keeping the current value of the variable
  173.              if a carriage return is input.
  174.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  175.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  176.              character in the input string.
  177.   NOTES:     Should someday be modified to allow input from any file type,
  178.              i.e., not just INPUT.
  179.   AUTHOR:    M. Riebe  11/17/84
  180.   CHANGES:   5/15/85 MTR: Fixed input routine to allow backspaces for
  181.                           corrections.
  182.              6/20/85 RJC: Improved error correction.
  183.              5/8/90  RJC: Translated to Turbo Pascal.  Added same changes
  184.                as versions 1.1 of RDDBLN.
  185.              5/18/91 RJC: Corrected number of digits error to allow up to
  186.                6 digits.
  187. ******************************************************************************}
  188. PROCEDURE rdintln;
  189. VAR
  190.   CH        : CHAR;
  191.   ascii     : array[1..10] of INTEGER;
  192.   I,J,START : INTEGER;
  193.   NEG       : BOOLEAN;
  194. BEGIN
  195.   NEG:=FALSE; START:=0; I:=1;
  196.   REPEAT
  197.     IF I>=7 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
  198.     ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
  199.     ASCII[I]:=ORD(CH);
  200.     IF (ASCII[I] = 8) THEN BEGIN
  201.       IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
  202.       IF I<=2 THEN I:=0 ELSE I:=I-2;
  203.       END
  204.     ELSE WRITE(WINDOW,CH);
  205.     I:=I+1;
  206.   UNTIL ORD(CH)=13;
  207.   I:=I-1;                    {leave index at last character}
  208.   IF ascii[1] <> 13 THEN BEGIN
  209.     REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
  210.     IF ASCII[1]=45 THEN NEG:=TRUE;
  211.     value := 0;
  212.     FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
  213.     IF NEG THEN VALUE:=-VALUE;
  214.     END;
  215.   WRITE(WINDOW,CHR($0A)); {line feed}
  216. END;
  217.  
  218. {******************************************************************************
  219.   TITLE:     RDLONGLN(VAR WINDOW:TEXT; VAR VALUE:LONGINT);
  220.   FUNCTION:  To provide a mechanism for reading long integers from the
  221.              keyboard while providing for keeping the current value of
  222.              the variable if a carriage return is input.
  223.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  224.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  225.              character in the input string.
  226.   AUTHOR:    R. Carlson 5/18/91
  227.   CHANGES:
  228. ******************************************************************************}
  229. PROCEDURE RDLONGLN;
  230. VAR
  231.   CH        : CHAR;
  232.   ascii     : array[1..13] of INTEGER;
  233.   I,J,START : INTEGER;
  234.   NEG       : BOOLEAN;
  235. BEGIN
  236.   NEG:=FALSE; START:=0; I:=1;
  237.   REPEAT
  238.     IF I>=12 THEN
  239.        REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
  240.     ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
  241.     ASCII[I]:=ORD(CH);
  242.     IF (ASCII[I] = 8) THEN BEGIN
  243.       IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
  244.       IF I<=2 THEN I:=0 ELSE I:=I-2;
  245.       END
  246.     ELSE WRITE(WINDOW,CH);
  247.     I:=I+1;
  248.   UNTIL ORD(CH)=13;
  249.   I:=I-1;                    {leave index at last character}
  250.   IF ascii[1] <> 13 THEN BEGIN
  251.     REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
  252.     IF ASCII[1]=45 THEN NEG:=TRUE;
  253.     value := 0;
  254.     FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
  255.     IF NEG THEN VALUE:=-VALUE;
  256.     END;
  257.   WRITE(WINDOW,CHR($0A)); {line feed}
  258. END;
  259.  
  260. PROCEDURE RDSTR(VAR WINDOW:TEXT; VAR VALUE:STR160; MAX:INTEGER);
  261. {******************************************************************************
  262.   FUNCTION:  To read a string input and if the input is not <CR>, assign it
  263.              to the variable.
  264.   INPUTS:    A string of length MAX up to 160 characters.
  265.   OUTPUTS:   The input string if it was not simply a <CR>.
  266.   AUTHOR:    Adapted by Roger Carlson from rdstr160 of M. Riebe.
  267. ******************************************************************************}
  268. VAR INSTRING:STR160; C:STRING[1]; CH:CHAR;
  269. BEGIN
  270.   INSTRING:='';
  271.   REPEAT
  272.     IF LENGTH(INSTRING)>=MAX THEN
  273.       REPEAT CH:=READKEY UNTIL CH IN [CHR(8),CHR(13)]
  274.     ELSE REPEAT CH:=READKEY UNTIL CH<>#0;
  275.     IF NOT ((LENGTH(INSTRING)=0) AND (CH=CHR(8))) THEN
  276.       IF CH=CHR(8) THEN WRITE(WINDOW,CH,' ',CH) ELSE WRITE(WINDOW,CH);
  277.     C[0]:=CHR(1); C[1]:=CH;
  278.     IF ORD(CH)=8 THEN DELETE(INSTRING,LENGTH(INSTRING),1)
  279.     ELSE IF ORD(CH)<>13 THEN INSTRING:=CONCAT(INSTRING,C);
  280.   UNTIL ORD(CH)=13;
  281.   WRITE(WINDOW,CHR($0A)); {line feed}
  282.   IF INSTRING<>'' THEN VALUE:=INSTRING;
  283. END;
  284.  
  285. PROCEDURE GRDSTR(VAR VALUE:STR160; MAX:INTEGER);
  286. {******************************************************************************
  287.   FUNCTION:  To read a string input with echoing to the graphics screen.
  288.              If the string is unchanged if a carriage return is entered.
  289.   INPUTS:    A string of length MAX up to 160 characters.
  290.   OUTPUTS:   The input string if it was not simply a <CR>.
  291.   AUTHOR:    Adapted by Roger Carlson from rdstr160 of M. Riebe.
  292. ******************************************************************************}
  293. VAR INSTRING :STR160; C:STRING[1]; CH:CHAR;
  294.     SETTINGS : TEXTSETTINGSTYPE;
  295.     DX,X,Y   : INTEGER;
  296.     VIEWPORT : VIEWPORTTYPE;
  297. BEGIN
  298.   GETTEXTSETTINGS(SETTINGS);
  299.   GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
  300.   DX:=SETTINGS.CHARSIZE*8;
  301.   INSTRING:='';
  302.   REPEAT
  303.     IF LENGTH(INSTRING)>=MAX THEN
  304.       REPEAT CH:=READKEY UNTIL CH IN [CHR(8),CHR(13)]
  305.     ELSE REPEAT CH:=READKEY UNTIL CH<>#0;
  306.     IF NOT ((LENGTH(INSTRING)=0) AND (CH=CHR(8))) THEN
  307.       IF CH=CHR(8) THEN BEGIN
  308.         MOVEREL(-DX,0); X:=GETX; Y:=GETY;
  309.         SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
  310.         SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
  311.         MOVETO(X,Y);
  312.         END {IF}
  313.       ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
  314.     C[0]:=CHR(1); C[1]:=CH;
  315.     IF ORD(CH)=8 THEN DELETE(INSTRING,LENGTH(INSTRING),1)
  316.     ELSE IF ORD(CH)<>13 THEN INSTRING:=CONCAT(INSTRING,C);
  317.   UNTIL ORD(CH)=13;
  318.   IF INSTRING<>'' THEN VALUE:=INSTRING;
  319. END;
  320.  
  321. {******************************************************************************
  322.   TITLE:     grdint(VAR VALUE:INTEGER);
  323.   FUNCTION:  To provide a mechanism for reading integers from a graphics
  324.              screen.
  325.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  326.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  327.              character in the input string.
  328.   AUTHOR:    R. Carlson   3/28/91
  329.   CHANGES:
  330. ******************************************************************************}
  331. PROCEDURE grdint;
  332. VAR
  333.   SETTINGS  : TEXTSETTINGSTYPE;
  334.   DX,X,Y    : INTEGER;
  335.   VIEWPORT  : VIEWPORTTYPE;
  336.   CH        : CHAR;
  337.   ascii     : array[1..10] of INTEGER;
  338.   I,J,START : INTEGER;
  339.   NEG       : BOOLEAN;
  340. BEGIN
  341.   GETTEXTSETTINGS(SETTINGS);
  342.   GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
  343.   DX:=SETTINGS.CHARSIZE*8;
  344.   NEG:=FALSE; START:=0; I:=1;
  345.   REPEAT
  346.     IF I>=6 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
  347.     ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
  348.     ASCII[I]:=ORD(CH);
  349.     IF NOT ((I=1) AND (CH=CHR(8))) THEN BEGIN
  350.       IF CH=CHR(8) THEN BEGIN
  351.         IF I<>1 THEN BEGIN
  352.           MOVEREL(-DX,0); X:=GETX; Y:=GETY;
  353.           SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
  354.           SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
  355.           MOVETO(X,Y);
  356.           END; {IF I<>1}
  357.         IF I<=2 THEN I:=0 ELSE I:=I-2;
  358.         END {IF CH=CHR(8)}
  359.       ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
  360.       I:=I+1;
  361.       END; {IF}
  362.   UNTIL ORD(CH)=13;
  363.   I:=I-1;                    {leave index at last character}
  364.   IF ascii[1] <> 13 THEN BEGIN
  365.     REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
  366.     IF ASCII[1]=45 THEN NEG:=TRUE;
  367.     value := 0;
  368.     FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
  369.     IF NEG THEN VALUE:=-VALUE;
  370.     END;
  371. END;
  372.  
  373. {******************************************************************************
  374.   TITLE:     grddbl(VAR VALUE:DOUBLE);
  375.   FUNCTION:  To provide a mechanism for reading double precision numbers
  376.              from a graphics screen.
  377.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  378.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  379.              character in the input string.
  380.   AUTHOR:    R. Carlson   5/3/91
  381.   CHANGES:
  382. ******************************************************************************}
  383. PROCEDURE grddbl;
  384. VAR
  385.   SETTINGS  : TEXTSETTINGSTYPE;
  386.   DX,X,Y    : INTEGER;
  387.   VIEWPORT  : VIEWPORTTYPE;
  388.   CH        : CHAR;
  389.   ascii     : array[1..12] of INTEGER;
  390.   I,J,N,START,START1 : INTEGER;
  391.   NEG       : BOOLEAN;
  392.   POWNEG    : BOOLEAN;
  393.   POWVAL    : INTEGER;
  394. BEGIN
  395.   GETTEXTSETTINGS(SETTINGS);
  396.   GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
  397.   DX:=SETTINGS.CHARSIZE*8;  I:=1;
  398.   REPEAT
  399.     IF I>=12 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)];
  400.     REPEAT CH:=READKEY
  401.     UNTIL CH IN ['0'..'9','.','+','-','E','e',CHR(13),CHR(8)];
  402.     ASCII[I]:=ORD(CH);
  403.     IF NOT ((I=1) AND (CH IN [CHR(8),'.','e','E'])) THEN BEGIN
  404.       IF CH=CHR(8) THEN BEGIN
  405.         IF I<>1 THEN BEGIN
  406.           MOVEREL(-DX,0); X:=GETX; Y:=GETY;
  407.           SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
  408.           SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
  409.           MOVETO(X,Y);
  410.           END; {IF I<>1}
  411.         IF I<=2 THEN I:=0 ELSE I:=I-2;
  412.         END {IF CH=CHR(8)}
  413.       ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
  414.       I:=I+1;
  415.       END; {IF}
  416.   UNTIL ORD(CH)=13;
  417.   I:=I-1;                    {leave index at last character}
  418.   IF ascii[1] <> 13 THEN BEGIN
  419.     START:=0; START1:=0;
  420.     REPEAT START:=START+1 UNTIL ASCII[START] IN [43,45,48..57];
  421.     REPEAT START1:=START1+1 UNTIL ASCII[START1] IN [46,69,101,13];
  422.     NEG:=FALSE;
  423.     CASE ASCII[START] OF
  424.       45: BEGIN {-} NEG:=TRUE;  START:=START+1; END;
  425.       43: {+}  START:=START+1;
  426.     END; {CASE}
  427.     value := 0;
  428.     FOR J:=START TO (START1-1) DO {left of decimal}
  429.        VALUE:=VALUE+(ASCII[J]-48)*PWROF10(START1-J-1);
  430.     IF ASCII[START1]=46 THEN BEGIN {'.'}
  431.       J:=START1;
  432.       REPEAT J:=J+1 UNTIL ASCII[J] IN [69,101,13];
  433.       FOR N:=START1+1 TO J-1 DO VALUE:=VALUE+(ASCII[N]-48)/PWROF10(N-START1);
  434.       START1:=J;
  435.       END;
  436.     POWVAL:=0;
  437.     IF ASCII[START1] IN [69,101] THEN BEGIN {'E','e'}
  438.       START1:=START1+1; POWNEG:=FALSE;
  439.       CASE ASCII[START1] OF
  440.         45: BEGIN {-} POWNEG:=TRUE; START1:=START1+1; END;
  441.         43: {+} START1:=START1+1;
  442.       END; {CASE}
  443.       FOR N:=START1 TO I-1 DO POWVAL:=POWVAL
  444.                               +(ASCII[N]-48)*ROUND(PWROF10(I-N-1));
  445.       END; {IF}
  446.     IF NEG THEN VALUE:=-VALUE;
  447.     IF POWNEG THEN VALUE:=VALUE/PWROF10(POWVAL)
  448.     ELSE VALUE:=VALUE*PWROF10(POWVAL);
  449.     END;
  450. END;
  451.  
  452. {******************************************************************************
  453.   TITLE:     GRDREAL(VAR VALUE:REAL);
  454.   FUNCTION:  To provide a mechanism for reading real numbers from a graphics
  455.              screen.
  456.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  457.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  458.              character in the input string.
  459.   AUTHOR:    R. Carlson   5/3/91
  460.   CHANGES:
  461. ******************************************************************************}
  462. PROCEDURE GRDREAL;
  463. VAR DBLTEMP:DOUBLE;
  464. BEGIN DBLTEMP:=VALUE; GRDDBL(DBLTEMP); VALUE:=DBLTEMP; END;
  465.  
  466. {******************************************************************************
  467.   TITLE:     rdstrxxx(VAR WINDOW:TEXT; VAR VALUE:STRxxx);
  468.   FUNCTION:  To read a string input and if the input is not <CR>, assign it
  469.              to the variable.
  470.   INPUTS:    A string of up to 160 characters.
  471.   OUTPUTS:   The input string if it was not simply a <CR>.
  472.   AUTHOR:    M. Riebe   11/17/84
  473.   CHANGES:   12/06/84:  Fixed input/output so that it is cleaner.
  474.              9/24/85 RJC: Switched to single character reading so that input
  475.                           can be echoed to any window.
  476.              9/25/85 RJC: Modified so that all use rdstr160.
  477.                           Added rdstr80.
  478.              2/04/86 RJC: Added rdstr30 and rdstr40.
  479.                           Added truncation of strings to the correct size.
  480.              4/8/90  RJC: Translated to Turbo Pascal.  Modified to use the
  481.                           local procedure RDSTR.
  482. ******************************************************************************}
  483. PROCEDURE RDSTR160;
  484. VAR ST:STR160;
  485. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,160); VALUE:=ST; END;
  486.  
  487. PROCEDURE GRDSTR160;
  488. VAR ST:STR160;
  489. BEGIN ST:=VALUE; GRDSTR(ST,160); VALUE:=ST; END;
  490.  
  491. PROCEDURE RDSTR80;
  492. VAR ST:STR160;
  493. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,80); VALUE:=ST; END;
  494.  
  495. PROCEDURE GRDSTR80;
  496. VAR ST:STR160;
  497. BEGIN ST:=VALUE; GRDSTR(ST,80); VALUE:=ST; END;
  498.  
  499. PROCEDURE RDSTR40;
  500. VAR ST:STR160;
  501. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,40); VALUE:=ST; END;
  502.  
  503. PROCEDURE GRDSTR40;
  504. VAR ST:STR160;
  505. BEGIN ST:=VALUE; GRDSTR(ST,40); VALUE:=ST; END;
  506.  
  507. PROCEDURE rdstr30;
  508. VAR ST:STR160;
  509. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,30); VALUE:=ST; END;
  510.  
  511. PROCEDURE Grdstr30;
  512. VAR ST:STR160;
  513. BEGIN ST:=VALUE; GRDSTR(ST,30); VALUE:=ST; END;
  514.  
  515. PROCEDURE rdstr20;
  516. VAR ST :STR160;
  517. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,20); VALUE:=ST; END;
  518.  
  519. PROCEDURE Grdstr20;
  520. VAR ST :STR160;
  521. BEGIN ST:=VALUE; GRDSTR(ST,20); VALUE:=ST; END;
  522.  
  523. PROCEDURE rdstr3;
  524. VAR ST : STR160;
  525. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,3); VALUE:=ST; END;
  526.  
  527. PROCEDURE Grdstr3;
  528. VAR ST : STR160;
  529. BEGIN ST:=VALUE; GRDSTR(ST,3); VALUE:=ST; END;
  530.  
  531. PROCEDURE rdcharln;
  532. VAR ST:STR160;
  533. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,1); VALUE:=ST[1]; END;
  534.  
  535. PROCEDURE Grdchar;
  536. VAR ST:STR160;
  537. BEGIN ST:=VALUE; GRDSTR(ST,1); VALUE:=ST[1]; END;
  538.  
  539. {******************************************************************************}
  540. {************** FUNCTION CALCINCR(INCR:DOUBLE):DOUBLE  ************************}
  541. {******************************************************************************}
  542. FUNCTION CALCINCR;
  543.   {Calculates a round number increment given an approximate increment INCR.}
  544. VAR POWER : LONGINT;      FRACTION : DOUBLE;
  545. BEGIN
  546.   POWER:=TRUNC(LOG(INCR)); FRACTION:=INCR/PWROF10(POWER);
  547.   WHILE FRACTION<1 DO BEGIN
  548.     POWER:=POWER-1; FRACTION:=INCR/PWROF10(POWER);
  549.     END; {WHILE}
  550.   IF FRACTION<2 THEN CALCINCR:=1.0E0 * PWROF10(POWER)
  551.   ELSE IF FRACTION<5 THEN CALCINCR:=2.0E0 * PWROF10(POWER)
  552.   ELSE IF FRACTION<10 THEN CALCINCR:=5.0E0 * PWROF10(POWER)
  553.   ELSE CALCINCR:=10.0E0 * PWROF10(POWER);
  554. END; {FUNCTION CALCINCR}
  555.  
  556. {******************************************************************************}
  557. {* PROCEDURE ENGNOT(NUMBER:DOUBLE; VAR MANTISSA:DOUBLE; VAR EXPONENT:LONGINT) *}
  558. {******************************************************************************}
  559. PROCEDURE ENGNOT;
  560.   {convert number to engineering notation}
  561. BEGIN
  562.   IF NUMBER=0.0 THEN BEGIN
  563.     EXPONENT:=0; MANTISSA:=0.0;
  564.     END
  565.   ELSE BEGIN
  566.     EXPONENT:=TRUNC(LN(ABS(NUMBER))/LN(10));
  567.     IF LN(ABS(NUMBER))/LN(10) <0 THEN EXPONENT:=EXPONENT-1;
  568.     WHILE (EXPONENT MOD 3)<>0 DO EXPONENT:=EXPONENT-1;
  569.     MANTISSA:=NUMBER/PWROF10(EXPONENT);
  570.     END; {ELSE}
  571. END; {PROCEDURE ENGNOT}
  572.  
  573. {*****************************************************************************}
  574. {*************** FUNCTION NUMDEC(NUM:DOUBLE):INTEGER *************************}
  575. {*****************************************************************************}
  576. FUNCTION NUMDEC;
  577.   {calculates the number of decimals in a number - accurate to about 1 part
  578.    in 1E6}
  579. VAR EXTRA : DOUBLE;    DECIMALS : LONGINT;
  580. BEGIN
  581.   DECIMALS:=0;
  582.   EXTRA:=NUM*PWROF10(DECIMALS);
  583.   WHILE (EXTRA-TRUNC(EXTRA+EXTRA*(1E-6))) > (1E-6)*EXTRA DO BEGIN
  584.     DECIMALS:=DECIMALS+1;
  585.     EXTRA:=NUM*PWROF10(DECIMALS);
  586.     END; {WHILE}
  587.   NUMDEC:=DECIMALS;
  588. END; {FUNCTION NUMDEC}
  589.  
  590. {************************************************************************
  591.  TITLE    : EXISTS(FILENAME:STR30):BOOLEAN
  592.  AUTHOR   : Roger Carlson (August 1986)
  593.  FUNCTION : Checks if a file of the specified name already exists on disk.
  594.  INPUTS   : FILENAME - Name of the file.
  595.  OUTPUTS  : EXISTS   - TRUE = file exists.
  596.  NOTES    :
  597.  CHANGES  : (5/30/90,RJC) - Translated to Turbo Pascal.
  598. *************************************************************************}
  599. FUNCTION EXISTS;
  600. VAR TEMP:PATHSTR;
  601. BEGIN
  602.   TEMP:=FSEARCH(FILENAME,'');
  603.   IF TEMP='' THEN EXISTS:=FALSE ELSE EXISTS:=TRUE;
  604. END; {FUNCTION EXISTS}
  605.  
  606. {************************* PROCEDURE BEEP ******************************}
  607. PROCEDURE BEEP;
  608.   {This procedure sounds a short alarm of frequency HZ.}
  609. BEGIN
  610.   SOUND(HZ); DELAY(200); NOSOUND;
  611. END;
  612.  
  613. {************************ FUNCTION INTTOSTR ****************************}
  614. FUNCTION INTTOSTR;
  615. VAR S:STR80;
  616. BEGIN
  617.   STR(I,S); INTTOSTR:=S;
  618. END;
  619.  
  620. {************************ FUNCTION LNGTOSTR *****************************}
  621. FUNCTION LNGTOSTR;
  622. VAR S:STR80;
  623. BEGIN
  624.   STR(I,S); LNGTOSTR:=S;
  625. END;
  626.  
  627. {************************ FUNCTION RLTOSTR ******************************}
  628. FUNCTION RLTOSTR;
  629. VAR S:STR80;
  630. BEGIN
  631.   STR(RL:WIDTH,S); RLTOSTR:=S;
  632. END;
  633.  
  634. END.