Как нолики в конце убрать? и в чем ошибка?

[lubafffka]

Код:

uses crt;
var f1,f2:text;
    ch:char;
    str,name1,name2:string;
    i,a,n,s:integer;
begin
writeln ('Введите имя исходного файла');
 readln (name1);
 assign (f1,name1);
 rewrite (f1);
 write ('Введите количество символов ');
 read(a);
 write ('Введите символы ');
 while str<> '.' do
  begin

   read (str);
   writeln (f1,str);
  end;
  writeln ('Введите имя заполняемого файла');
 readln (name2);
 assign (f2,name2);
 rewrite (f2);
 reset (f1); n:=2*(trunc((a-trunc(a/6))/5)); s:=0;
 while not (eof(f1)) do
  begin
     write (f2,' ');
          write (f2,' ');
   for i:=1 to n do
    begin
     read (f1,ch);
     write (f2,ch,'     ');
    end;
   writeln (f2);
   write (f2,'   ');
   for i:=1 to n do
    begin
     read (f1,ch);
     write (f2,ch,'   '); write (f2,ch,' ');
    end;
   writeln (f2);
     write (f2,'    ');
   for i:=1 to n do
    begin
     read (f1,ch);
     write (f2,ch,' ');  write (f2,ch,'   ');
    end;
   writeln (f2);
     write (f2);
   for i:=1 to trunc(a/6) do
    begin
     read (f1,ch);
     write (f2,'     ',ch); write (f2,'     ',ch);
     end; close(f1);close(f2);
   end;

end.

Задание записать более 20 символов в файл в виде
1_____1
_1___1
__1_1
___1 и т.д.

[alex_fcsm]

Какие нолики?

uses crt;
var f1,f2:text;
ch:char;
str,name1,name2:string;
i,n,p:integer;
begin
clrscr;
writeln ('Введите имя исходного файла');
 readln (name1);
assign (f1,name1);
rewrite (f1);
writeln ('Введите символы ');
n:=0;
while str<>'.' do
begin
readln (str);
writeln (f1,str);
inc(n);
end;
close(f1);
assign(f1,name1);
writeln ('Введите имя заполняемого файла');
 readln (name2);
assign (f2,name2);
rewrite (f2);
reset (f1);
while not(eof(f1)) do
 begin
  for i:=1 to n do
   if i mod 8 = 1 then begin
                         readln(f1,ch);
                         write(f2,ch);
                       end
           else write(f2,'_');
   writeln(f2);
   for i:=1 to n do
   if (i mod 8 = 2)or(i mod 8 = 0) then begin
                         readln(f1,ch);
                         write(f2,ch);
                       end

           else write(f2,'_');
   writeln(f2);
   for i:=1 to n do
   if i mod 4 = 3 then begin
                         readln(f1,ch);
                         write(f2,ch);
                       end
           else write(f2,'_');
   writeln(f2);
     for i:=1 to n do
   if (i mod 8 = 4)or(i mod 8 = 6) then begin
                         readln(f1,ch);
                         write(f2,ch);
                       end
            else write(f2,'_');
   writeln(f2);
     for i:=1 to n do
   if i mod 8 = 5 then begin
                         readln(f1,ch);
                         write(f2,ch);
                       end
            else write(f2,'_');
   writeln;
 end;
 close(f1);
 close(f2);
end.