home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / FORTH-83 / BLKTOFTH.ARK / BLKTOFTH.PAS < prev   
Pascal/Delphi Source File  |  1986-03-11  |  2KB  |  86 lines
  1. Program blktotext (input,output,infile,outfile);
  2. { this program converts f83 block files to text files }
  3.  
  4. Const
  5.   Blksize = 1024;
  6.  
  7. Var
  8.   infile : file of char;
  9.   outfile : text;
  10.   line : string[64];
  11.   element : char;
  12.   i,j,linenum,screenum : integer;
  13.   notfound : boolean;
  14.  
  15. Begin { main program }
  16.   if (paramcount > 2) then begin
  17.     writeln ('Two many parameters');
  18.     writeln ('blktofth <blkfile> <fthfile>');
  19.     halt (1);
  20.     end;
  21.   if (paramcount = 2) then begin
  22.     assign (infile,paramstr(1));
  23.     reset (infile);
  24.     assign (outfile,paramstr(2));
  25.     rewrite (outfile);
  26.     end;
  27.   if (paramcount = 1) then begin
  28.     assign (infile,paramstr(1));
  29.     reset (infile);
  30.     write ('Output file : ');
  31.     readln (line);
  32.     assign (outfile,line);
  33.     rewrite (outfile);
  34.     end;
  35.   if (paramcount = 0) then begin
  36.     write ('Input file : ');
  37.     readln (line);
  38.     assign (infile,line);
  39.     reset (infile);
  40.     write ('Output file : ');
  41.     readln (line);
  42.     assign (outfile,line);
  43.     rewrite (outfile);
  44.     end;
  45.   linenum := 0;
  46.   screenum := 0;
  47.   while not eof(infile) do begin  { main loop }
  48.       line := '';
  49.       if (linenum = 0) then begin { two blank lines if beginning of screen }
  50.         writeln (outfile);
  51.         writeln (outfile);
  52.         writeln (outfile,'Scr #',screenum);
  53.         end;
  54.       for i:= 1 to 64 do begin { read a line in }
  55.         if not eof(infile) then
  56.             read (infile,element)
  57.         else
  58.             element := ' ';
  59.         line := concat (line,element);
  60.         end;
  61. {      writeln ('After reading in line ',line); }
  62.       { find end of string }
  63.       notfound := true; { true until space not found }
  64.       for i := 1 to 64 do begin
  65.         j := 65 - i;
  66.         if ((line[j] = ' ') and (notfound)) then
  67.            delete (line,j,1)
  68.         else
  69.            notfound := false;
  70.         end; { for loop }
  71. {        writeln ('Length of line and line ',length(line),line); }
  72.       if (linenum < 10) then
  73.         write (outfile,' ',linenum,': ')
  74.       else
  75.         write (outfile,linenum,': ');
  76.       writeln (outfile,line); { write out the result }
  77.       linenum := linenum + 1;
  78.       if (linenum = 16) then begin
  79.          linenum := 0;
  80.          screenum := screenum + 1;
  81.          end;
  82.   end;
  83.   close (outfile);
  84.   close (infile);
  85.   end.
  86.