program iodemo(inp,output,infile,outfile);
type
    string15=packed array[1..15]of char;
    ptr31   =^string31;
    string31=packed array[0..31]of char;
var
    infile,outfile,inp:text;
procedure pprompt(s:string15);extern;
procedure define(k:integer;p:ptr31);extern;

procedure define_files;
var filename:string31;length:integer;first_try,ok:boolean;

function get_name(prompt:string15;var l:integer;var name:string31):boolean;
var ok:boolean;temp:integer;
begin
if first_try then begin pprompt(prompt);reset(inp);first_try:=false;end
             else begin pprompt(prompt);while inp^=' ' do get(inp);end;
for l:=0 to 31 do name[l]:=' ';
l:=1;
while (inp^<>' ') and not(eoln(inp)) and (l<29) do begin
      name[l]:=inp^;get(inp);l:=l+1;end;
for l:=l downto 1 do 
      if ('a'<=name[l])and(name[l]<='z')then 
           name[l]:=chr(ord(name[l])-ord('a')+ord('A'));
l:=31;while (name[l]=' ') and (l>0) do l:=l-1;
ok:=(l>0)and(inp^=' ');
if not ok and (l>0) then writeln('Invalid filename ',name);
if not ok then while (inp^<>' ') and not(eof(inp)) do get(inp);
get_name:=ok;
end;{of get_name}

procedure call_define(stream,length:integer;filename:string31);
const magic=402653312;
var p31:ptr31;i:integer;
begin
new(p31);p31^:=filename;
for i:=31 downto 2 do p31^[i]:=p31^[i-2];
p31^[2]:=',';
p31^[1]:=chr(stream+ord('0'));
writeln('Command:define ',p31^);
p31^[0]:=chr(length+2);
define(magic,p31);
dispose(p31);
end;{of call_define}

begin {define_files}
first_try:=true;
writeln('Please give the name of the input file to be used:');
for length:=0 to 31 do filename[length]:=' ';
filename[1]:='.';filename[2]:='I';filename[3]:='N';
call_define(1,3,filename);
repeat; ok:=get_name('Input file:    ',length,filename);until ok;
call_define(3,length,filename);
writeln('Please give the name of the output file to be used:');
repeat; ok:=get_name('Output file:   ',length,filename);until ok;
call_define(4,length,filename);
end;{ of define_files}

begin {main program}
writeln('This demonstration program shows how to avoid that "Data:" prompt');
writeln('that appears when you run a program. I askes for the names of two');
writeln('files and copies the input file to the output file               ');
writeln('File names must be no more than 29 characters long');
writeln;
define_files;
reset(infile);
rewrite(outfile);
while not eof(infile) do begin
   while not eoln(infile)do begin
      outfile^:=infile^;get(infile);put(outfile);
   end;
   writeln(outfile);
   if not eof(infile) then get(infile);
end;
end.