unit fortwrap;

{$MODE Delphi}

interface

uses SysUtils, FileUtil;

function FortranWrap(filename: String): Integer;
//will wrap all lines that exceed 72 columns,
//except those containing a comment
//returns number of lines wrapped

function Fortran90Wrap(filename: String): Integer;
//will wrap all lines that exceed 200 columns,
//except those containing a comment
//returns number of lines wrapped

implementation

function FortranWrap(filename: String): Integer;
var
  Q, Z: TextFile;
  s, s1, comment: String;
  wrappedlines: Integer;
begin
  wrappedlines:=0;
  AssignFile(Q,filename);
  reset(Q);
  AssignFile(Z,filename+'.tmp');
  rewrite(Z);
  while not EOF(Q) do
  begin
    readln(Q,s);
    if (copy(s,1,1)='c') or (copy(s,1,1)='C') or (copy(s,1,1)='!') or (copy(s,1,1)='#') then
      writeln(Z,s)
    else
    begin
      comment:='';
      if pos('!',s)>0 then
      begin
        comment:=copy(s,pos('!',s),length(s));
        s:=copy(s,1,pos('!',s)-1);
      end;
      s1:=copy(s,1,6);
      write(Z,s1);
      s:=copy(s,7,length(s));
      while length(s)>66 do
      begin
        wrappedlines:=wrappedlines+1;
        s1:=copy(s,1,66);
        writeln(Z,s1);
        write(Z,'     &');
        s:=copy(s,67,length(s));
      end;
      write(Z,s);
      writeln(Z,comment);
    end;
  end;
  closefile(Z);
  closefile(Q);
  DeleteFileUTF8(filename); { *Converted from DeleteFile*  }
  RenameFileUTF8(filename+'.tmp',filename); { *Converted from RenameFile*  }
  result:=wrappedlines;
end;

function Fortran90Wrap(filename: String): Integer;
var
  Q, Z: TextFile;
  s, s1, comment: String;
  wrappedlines: Integer;
begin
  wrappedlines:=0;
  AssignFile(Q,filename);
  reset(Q);
  AssignFile(Z,filename+'.tmp');
  rewrite(Z);
  while not EOF(Q) do
  begin
    readln(Q,s);
      comment:='';
      if pos('!',s)>0 then
      begin
        comment:=copy(s,pos('!',s),length(s));
        s:=copy(s,1,pos('!',s)-1);
      end;
      while length(s)>200 do
      begin
        wrappedlines:=wrappedlines+1;
        s1:=copy(s,1,200);
        write(Z,s1);
        writeln(Z,'&');
        s:=copy(s,201,length(s));
      end;
      write(Z,s);
      writeln(Z,comment);
  end;
  closefile(Z);
  closefile(Q);
  deletefileUTF8(filename);
  renamefileUTF8(filename+'.tmp',filename);
  result:=wrappedlines;
end;

end.
