Category : Miscellaneous Language Source Code
Archive   : NEURAL.ZIP
Filename : XFACE.INC

type
mstring = string[100];
var
outfile : text;

FUNCTION yes(PROMPT:MSTRING): BOOLEAN;
var
ch : string[2];
begin
(*$I-*)(*$R-*)
repeat
write(prompt,' (y/n) ');
readln(ch);
until (ch ='y') or (ch = 'Y') or (ch ='N') or (ch ='n') and (ioresult=0);
(*$I+*)(*$R+*)
yes := (ch ='y') or (ch ='Y');
end;

PROCEDURE setoutfile;
var
ch: char;
begin
(*$I-*)(*$R-*)
repeat
write('OUTPUT DESTINATION: P(rinter C(onsole : ');
readln(ch);
until (ch in['c','C','p','P']) and (ioresult = 0);
case ch of
'p','P' : ASSIGN(outfile,'LST:');
'c','C' : ASSIGN(outfile,'CON:');
end; (*case*)
REWRITE(OUTFILE);
(*$I+*)(*$R+*)
end; (*setoutfile*)


FUNCTION getnum(PROMPT:MSTRING; LOW,HIGH:INTEGER):INTEGER;
var
val : integer;
begin
VAL := -31695;
(*$I-*)(*$R-*)
repeat
write(prompt,'(',low,'..',high,'): ');
readln(val);

if (val < low) or (val > high)
then writeln(' VALUE OUT OF RANGE ');
if ioresult <> 0
then writeln('WRONG DATA TYPE ');
until (val >= low) and (val <= high) and (ioresult = 0);
getnum := val;
(*$I+*)(*$R+*)
end;

FUNCTION getchar(PROMPT:MSTRING):CHAR;
var
ch : char;
begin
(*$I-*)(*$R-*)
repeat
write(prompt);
readln(ch);
until (ch IN ['a'..'z','A'..'Z']) and (ioresult = 0);
getchar := ch;
(*$I+*)(*$R+*)
end;

FUNCTION getreal(PROMPT:MSTRING; LOW,HIGH:REAL):REAL;
var
val : real;
begin
VAL := -31695.7;
(*$I-*)(*$R-*)
repeat
write(prompt,'(',low:3:1,'..',high:3:1,'): ');
readln(val);
if (val < low) or (val > high) or (ioresult <> 0)
then writeln(' Data incorrect type or out of range ');
until (val >= low) and (val <= high) and (ioresult = 0);
getreal := val;
(*$I+*)(*$R+*)
end;