{*****************************************************************************}
{STRIPA76.PAS  JULY 1987}

{CHOICE 1}
{Program converts a file containing non printing chars to an ASCII file }
{which can be printed. The seventh bit of all chars is zeroed and all }
{non-printing characters are eliminated. Lone CR or lone LF made CRLF or LFCR}

{CHOICE 2}
{same as choice 1 with cr lf limited to two max}

{CHOICE 3}
{same as choice 1 except CR & LF eliminated and CR LF INSERTED AFTER 80 CHARS}
{FOR USE WITH FILES CREATED WITH CAMERA.COM}

{CHOICE 4}
{same as 1 for ws document files. Changes "soft hyphens" (1fh) to normal}
{hyphen (2dh) and changes "non-break-spaces" (0fh) to normal spaces. (20h)}

{CHOICE 5}
{Restores files stripped in 4 to WS document files}

{CHOICE 6&7}
{6 = BITSTRIP - same as 1 with lone crlf changed to DB
{7 = RESTORES BITSTRIPPED FILE TO WS DOCUMENT FILE}
{*****************************************************************************}

program strip (input, output);

const { global constants }
      widthcntr = 1;           {initial value of width counter}
      cho1 =1;
      cho2 =2;
      cho3 =3;
      cho4 =4;
      cho5 =5;
      cho6 =6;
      cho7 =7;
      wschar = $a0;
var { global variables }
       infile  : file of integer;
       outfile : file of char;
lochr,hichr,crlfcntr,f3,xcr,xlf, cntr, m, n,na,nb,nc,nd,ne,nn, o : integer;
cont,scr,bslflag,bshflag,bsflag,bschr,lflag,sflag : integer;
contue,keyflag,LFonlyflag,CRonlyflag : integer;

   ques,ch, p : char;
   cr, lf : byte;
        f : array [1..2] of string [14];
        IOerr : boolean;
{*****************************************************************************}

procedure initf;
begin {initf}
      f[1] := '';
      f[2] := '';
      cr := 13;
      scr := $8d;
      lf := 10;
      cntr := widthcntr;
      crlfcntr :=1;
      f3 := 0;
      lochr :=31;
      hichr := 126;
      nn := $ffff;
      sflag := $0;
      lflag := $0;
      bsflag := $0;
      bslflag := $0;
      bshflag := $0;
      bschr := $db;
      cont := $ff;
      CRonlyflag :=0;
      LFonlyflag :=0;
      keyflag :=1;
end;
{*****************************************************************************}
procedure ckcmd;
begin
  while keypressed do
    begin
      read(kbd,ch);
      keyflag := keyflag * -1;
    end;
end;
{*****************************************************************************}
procedure crlf;
begin
     p := chr($0D);
     write(outfile,p);
     p := chr($0A);
     write(outfile,p);
     cntr := widthcntr;
end;
{*****************************************************************************}
procedure stripo;
begin

  if (crlfcntr > 1) then
   if (o=$0a) or (o=$0d) then
    crlfcntr:=crlfcntr
     else
     begin
      crlfcntr:=1
    end;

  if (crlfcntr > 4) then
   if (o=$0a) or (o=$0d) then
    o:=$0
     else
     begin
      crlfcntr:=1
    end;

 while (o > lochr) and (o < hichr) or (o = xcr) or (o = xlf) do
  begin
  o := o and $ff7f;

   if o = $1f then
    o := $2d;
     if o = $0f then
      o := $20;

{***pairs lone cr & lf***}
   if (LFonlyflag = 255) and (CRonlyflag=255)
   then
   begin
   LFonlyflag:=0;
   CRonlyflag:=0;
   end;

   if (CRonlyflag = 255) and (o <> lf)
   then
   begin
   CRonlyflag:=0;
   p:=chr(lf);
  if keyflag = 1 then
   write (output,chr(lf));
   write (outfile,p);
   end;

   if (LFonlyflag = 255) and (o <> cr)
   then
   begin
   LFonlyflag:=0;
   p:=chr(cr);
  if keyflag = 1 then
   write (output,chr(cr));
   write (outfile,p);
   end;

    if (o=lf) then
     LFonlyflag:=255;

    if (o=cr) then
     CRonlyflag:=255;

{***}
if f3 = cho2 then
    if (o=cr) or (o=lf) then
     crlfcntr := crlfcntr + 1;
     if keyflag = 1 then
       write (output,chr(o));
       p := chr(o);
       write(outfile,p);
       o := $0;
       if f3 = cho3 then
       cntr := cntr + 1;
  end;
end;
{*****************************************************************************}
procedure flipn;
begin
         na := nn;
         nn := n;
         n  := na;
         nb := lo(n);
         nc := hi(n);
         nd := lo(nn);
         ne := hi(nn);
end;

{*****************************************************************************}
procedure wcrlf;
begin
           p := chr(scr);
           write(outfile,p);
          if keyflag = 1 then
           write (output,chr(cr));
           p := chr(lf);
           write(outfile,p);
          if keyflag = 1 then
           write (output,chr(lf));
end;
{*****************************************************************************}
procedure wsrestore;
begin

         flipn;

if f3=cho7
then
begin
         if (lo(n)=bschr) or (hi(n)=bschr)  {restore bitstrip file}
         then
         begin
          if lo(n) = bschr
          then
          begin
           wcrlf;
           p := chr(hi(n));
           write(outfile,p);
          if keyflag = 1 then
           write (output,chr(nc));
           n:=$ffff
         end
          else
          begin
           p := chr(lo(n));
           write(outfile,p);
          if keyflag = 1 then
           write (output,chr(nb));
           wcrlf;
          end;
          n:=$ffff;
         end;
end;


         if (nb <> $20) or (nc <> $20) then
         sflag :=$0;
         if (nb <> $0a) and (nc <> $0a) then
         lflag :=$0;

if lflag = 0
then
begin
  if sflag = 0
  then
  begin
           if (nc = $20) or (nc=$0a) or (nc=$2e)
           then
           begin
            if (nb <> $2e) and (nb<>$0a) then
            n := n or $0080;
           end;
        nd := lo(nn);
           if (nd = $20) or (nd = $0a) or (nd=$2e)
           then
           begin
            if (nc <> $2e) and (nc<>$0a) then
             n := n or $8000;
           end;
  end;
end;
    if (nb=$20) and (nc=$20) then
    n := n and $ff7f;
        o := lo(n);

if o <> 255
then
begin
             if o = $a0 then
             sflag := 255;
             if o = $8d then
             lflag := 255;

         p := chr(o);
         write(outfile,p);
      if keyflag = 1 then
       write (output,chr(o));
        o := hi(n);

             if o = $a0 then
             sflag := 255;
             if o = $8d then
             lflag := 255;

         p := chr(o);
         write(outfile,p);
      if keyflag = 1 then
       write (output,chr(o));
       end;
end;
{*****************************************************************************}
procedure bstrip;
begin
         if (lo(n)=bschr) or (hi(n)=bschr)
         then
         begin
           if (lo(n)=bschr) then
           n:=n and $7fff;
           if (hi(n)=bschr) then
           n:=n and $ff7f;
           end
           else begin
           n := n and $7f7f;
           end;

         flipn;

if n <> $ffff
then
begin
         if (nb<>$0d) and (nc<>$0d) then
         bsflag := $0;

        bslflag := $0;

    if (nb=$0d) and (nc=$0a) and (nd<>$0d) and (bsflag = $0)
    then
    begin
         p := chr(bschr);
         write(outfile,p);
       if keyflag = 1 then
         write (output,chr(cr));
       if keyflag = 1 then
         write (output,chr(lf));
         bslflag := 255;
    end
    else
    begin
      if bshflag = 0
      then
      begin
          o := lo(n);
          if o = $0d then
          bsflag := $255;
         p := chr(o);
         write(outfile,p);
       if keyflag = 1 then
         write (output,chr(o));
      end;
    end;

         bshflag :=0;

    if (nc=$0d) and (nd=$0a) and (ne<>$0d) and (bsflag = $0)
    then
    begin
         p := chr(bschr);
         write(outfile,p);
       if keyflag = 1 then
         write (output,chr(cr));
       if keyflag = 1 then
         write (output,chr(lf));
         bshflag := 255;
    end
    else
    begin
      if bslflag = 0
      then
      begin
         o := hi(n);
          if o = $0d then
          bsflag := 255;
         p := chr(o);
         write(outfile,p);
        if keyflag = 1 then
         write (output,chr(o));
      end;
    end;
end;
end; {7f7f}
{*****************************************************************************}
procedure stripit;
begin {stripit}
  reset(infile);
  assign (outfile, f[2]);
  rewrite (outfile);

  while not eof(infile) do
  begin {eof}
    read(infile,n);
    ckcmd;

    if (f3 = cho5) or (f3=cho7) then
    wsrestore;

    if f3 = cho6 then
    bstrip;

    if f3 < cho5
    then
    begin
      o := lo(n);
      stripo;
        while cntr > 80 do
        begin
          crlf
     end; {end cntr > 80}
       o := hi(n);
       stripo;
   while cntr > 80 do
   begin
     crlf
   end; {end cntr > 80}
end; {>5}
ckcmd;
end; {eof}
       if (f3 = cho5) or (f3=cho7)
       then
       begin
       n:=$ffff;
       wsrestore;
       end;

       if f3 = cho6
       then
       begin
       n:=$ffff;
       bstrip;
       end;
close (outfile);
close (infile);
end; {stripit}
{*****************************************************************************}
procedure signon;
begin
     ClrScr;
     write ('STRIPA76  JULY 1987');
     writeln;
     write ('Converts a file containing non-printing characters to an ASCII');
     writeln;
     write ('file which can be printed. The input file remains unchanged.');
     writeln;
     write ('The output file will overwrite any existing file with the same name!');
     writeln;writeln;
end;
{*****************************************************************************}
procedure getname;
begin
     writeln;

{$I-}
repeat
     write   ('Enter name of file to strip or hit ^C to exit: '); read (f[1]);
     writeln;
assign(infile, f[1]);
reset(infile);
IOerr := (IOresult<>0);
if IOerr then begin
writeln;writeln;
write ('***- error - Enter New File Name -***');writeln;
end;
until not IOerr;
{$I+}

     writeln;

  while f[2] = '' do
  begin
    write   ('***********************************************');
    writeln;
    write   ('Enter name of  output  file or hit ^C to exit: '); read (f[2]);
    writeln; writeln;
      if f[2]=f[1]
      then
      begin
        f[2] := '';
        writeln;
        write   ('Enter New Filename');
        writeln;
      end;
   end;

    clrscr;
    writeln;writeln;
    write (f[1]);
    write (' >>> will be stripped to >>> ');
    write (f[2]);
     writeln;writeln;writeln;
     write   ('1.     Strip and retain CR & LF  as they exist in file ');
     writeln;
     write   ('2.     Same as 1 except limit consecutive cr lf to two max');
     writeln;
     write   ('3.     Same as 1 with CR & lF every 80 characters only');
     writeln; writeln;writeln;
     write   ('4.     Filter WS document files - like 1 except:');
     writeln;
     write   ('       converts soft hyphens to normal hyphens and');
     writeln;
     write   ('       converts non-break-spaces to normal spaces');
     writeln;writeln;
     write   ('5.     Restore filtered WS file to document file');
     writeln; writeln;writeln;
     write   ('6.     Bitstrip - same as 1 with lone crlf changed to DB');
     writeln;
     write   ('7.     Restore bitstripped file to WS document file');
     writeln; writeln;
   while f3 = 0 do
   begin
     write   ('CHOICE: (enter  1 thru 7  or  hit ^C to exit )  ');read (f3);
     writeln; writeln;
     if (f3 > 7) or (f3 < 0) then
     f3 := 0
   end;

   if (f3=cho5) or (f3=cho7) then
   keyflag := keyflag * -1;

     if f3 = cho3
       then
       begin
       xcr := 32;
       xlf := 32
       end
     else
     begin
       xcr := $0D;
       xlf := $0A
     end;
       if f3 = 4
       then
       begin
       hichr := 255;
       lochr := 0
       end;
       clrscr;
       writeln;writeln;
       write ('PROCESSING: ');
       write (f[1]);
       write (' >>> stripped to >>> ');
       write (f[2]);
     writeln;writeln;
     write ('Hit any key to toggle console display on/off');
     writeln;writeln;
  end;

{*****************************************************************************}

begin { main }
     contue := 0;
 while contue = 0 do
 begin
     Initf;
     signon;
     getname;
     stripit;
     writeln;writeln;writeln;writeln;writeln;
     write ('***************************************************************');
     writeln;
     write (f[1]);write (' >>> stripped to >>> ');write (f[2]);
     writeln;writeln;
     write ('Strip another file ?  hit  Y  to continue or hit Return to exit');
reset (infile);
  ques := 'n';
  while ques = 'n' do begin
    if keypressed then begin
    read(kbd,ques);
    end;
   end;

     if (ques = 'y') or (ques = 'Y') then
      contue := 0
      else contue :=255
  end; {contue}
end. { main }

{*****************************************************************************}