home *** CD-ROM | disk | FTP | other *** search
- Procedure printfile (fn:lstr);
-
- Procedure getextension (VAR fname:lstr);
-
- Procedure tryfiles (a,b,c,d:integer);
- VAR q:boolean;
-
- Function tryfile (n:integer):boolean;
- const exts:array [1..4] of string[3]=('','ANS','ASC','40');
- begin
- if not exist (fname+'.'+exts[n]) then tryfile:=false else begin
- tryfile:=true;
- fname:=fname+'.'+exts[n]
- end
- end;
-
- begin
- if tryfile (a) then exit;
- if tryfile (b) then exit;
- if tryfile (c) then exit;
- q:=tryfile (d)
- end;
-
- begin
- if pos ('.',fname)<>0 then exit;
- if ansigraphics in urec.config then tryfiles (2,3,1,4) else
- if asciigraphics in urec.config then tryfiles (3,1,4,2) else
- if eightycols in urec.config then tryfiles (1,4,3,2) else
- tryfiles (4,1,3,2)
- end;
-
- VAR tf:text;
- k:char;
- begin
- clearbreak;
- writeln;
- getextension (fn);
- assign (tf,fn);
- reset (tf);
- iocode:=ioresult;
- if iocode<>0 then begin
- fileerror ('Printfile',fn);
- exit
- end;
- clearbreak;
- while not (eof(tf) or break or hungupon) do
- begin
- read (tf,k);
- write (k)
- end;
- if break then writeln (^B);
- writeln;
- textclose (tf);
- curattrib:=0;
- ansireset
- end;
-
- Procedure printtexttopoint (VAR tf:text);
- VAR l:lstr;
- begin
- l:='';
- clearbreak;
- while not (eof(tf) or hungupon) and (l<>'.') do begin
- if not break then writeln (l);
- readln (tf,l)
- end
- end;
-
- Procedure skiptopoint (VAR tf:text);
- VAR l:lstr;
- begin
- l:='';
- while not eof(tf) and (l<>'.') do
- readln (tf,l)
- end;