home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 270.img / FORUM25C.ZIP / PRNTFILE.SUB < prev    next >
Text File  |  1988-12-27  |  2KB  |  75 lines
  1. Procedure printfile (fn:lstr);
  2.  
  3.   Procedure getextension (VAR fname:lstr);
  4.  
  5.     Procedure tryfiles (a,b,c,d:integer);
  6.     VAR q:boolean;
  7.  
  8.       Function tryfile (n:integer):boolean;
  9.       const exts:array [1..4] of string[3]=('','ANS','ASC','40');
  10.       begin
  11.         if not exist (fname+'.'+exts[n]) then tryfile:=false else begin
  12.           tryfile:=true;
  13.           fname:=fname+'.'+exts[n]
  14.         end
  15.       end;
  16.  
  17.     begin
  18.       if tryfile (a) then exit;
  19.       if tryfile (b) then exit;
  20.       if tryfile (c) then exit;
  21.       q:=tryfile (d)
  22.     end;
  23.  
  24.   begin
  25.     if pos ('.',fname)<>0 then exit;
  26.     if ansigraphics in urec.config  then tryfiles (2,3,1,4) else
  27.     if asciigraphics in urec.config then tryfiles (3,1,4,2) else
  28.     if eightycols in urec.config    then tryfiles (1,4,3,2) else
  29.                                          tryfiles (4,1,3,2)
  30.   end;
  31.  
  32. VAR tf:text;
  33.     k:char;
  34. begin
  35.   clearbreak;
  36.   writeln;
  37.   getextension (fn);
  38.   assign (tf,fn);
  39.   reset (tf);
  40.   iocode:=ioresult;
  41.   if iocode<>0 then begin
  42.     fileerror ('Printfile',fn);
  43.     exit
  44.   end;
  45.   clearbreak;
  46.   while not (eof(tf) or break or hungupon) do
  47.     begin
  48.       read (tf,k);
  49.       write (k)
  50.     end;
  51.   if break then writeln (^B);
  52.   writeln;
  53.   textclose (tf);
  54.   curattrib:=0;
  55.   ansireset
  56. end;
  57.  
  58. Procedure printtexttopoint (VAR tf:text);
  59. VAR l:lstr;
  60. begin
  61.   l:='';
  62.   clearbreak;
  63.   while not (eof(tf) or hungupon) and (l<>'.') do begin
  64.     if not break then writeln (l);
  65.     readln (tf,l)
  66.   end
  67. end;
  68.  
  69. Procedure skiptopoint (VAR tf:text);
  70. VAR l:lstr;
  71. begin
  72.   l:='';
  73.   while not eof(tf) and (l<>'.') do
  74.     readln (tf,l)
  75. end;