Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/WSX.ZIP/WSX.PAS

Pascal/Delphi Source File | 1985-12-28 | 8.7 KB | 372 lines

program wsutil;

{WordStar file utility  --  3-27-85 Ver B5   }
{Copyright 1985 by David W. Carroll          }
{                                            }
{Converts WordStar files to ASCII text files }
{with options.                               }

{ModifieΣ b∙ Beε Ettelsoε 11-05-8╡ t∩ turε off
cursor, use gotoxy's in update window,
provide exit for null file name, and put ^Z at
end of file.}

const
   nummax      = 200;   {Maximum input line length}

   version     = 'B5';
   date        = 'March 27, 1985';

   null        = 00;
   bell        = 07;
   lf          = 10;
   ff          = 12;
   cr          = 13;
   nobrksp     = 15;   {no break space ^O}
   softhyph1   = 30;   {mid-text soft hyphen}
   softhyph2   = 31;   {eol soft hyphen}
   space       = 32;
   hyph        = 45;
   period      = 46;
   softlf      = 138;  {soft line feed}
   softcr      = 141;  {soft carriage return}
   softsp      = 160;  {soft space}

   ctlb        = 02;
   ctld        = 04;
   ctls        = 19;
   ctlt        = 20;
   ctlv        = 22;

{ arrays pcon and pcoff contain the strings that are  }
{ substituted for WordStar print control characters   }
{ ^b, ^d, ^s, ^t, and ^v. Constant pc is the total    }
{ number of WS print control characters supported.    }

   pc          = 05;
   spc:   array[1..pc] of byte = (ctlb, ctld, ctls, ctlt, ctlv);
   pcon:  array[1..pc] of string[10] =
            ('[bf]','[ds]','[us]','[sup]','[sub]');
   pcoff: array[1..pc] of string[10] =
            ('[ebf]','[eds]','[eus]','[esup]','[esub]');
type
    regpack =
      record
        case boolean of
          true:
            (ax, bx, cx, dx, bp, si, ds, es, flags: integer);
          false:
            (al, ah, bl, bh, cl, ch, dl, dh: byte);
      end;

var
   infile       :  text;
   outfile      :  text;
   numlist      :  array[1..nummax] of byte;
   flagpc       :  array[1..pc] of boolean;
   totchrin     :  real;
   totchrout    :  real;
   cnt          :  integer;
   quit         :  boolean;
   stripsp      :  boolean;
   striplf      :  boolean;
   chgpc        :  boolean;
   stripdc      :  boolean;
   strippc      :  boolean;
   translt      :  boolean;

  procedure cursor(on, block: boolean);
   {turn cursor on or off and set size}

    var
      regs: regpack;

    begin
      with regs do
        begin
          begin
            ah := $0F; {get current video state}
            intr($10, regs);
            if al = 7 then
              begin {80 x 25 using bw card}
                if block then
                  begin
                    ch := 0;
                    cl := 13;
                  end
                else
                  begin
                    ch := 11;
                    cl := 12;
                  end;
              end
            else
              begin {80 x 25 using color card}
                if block then
                  begin
                    ch := 0;
                    cl := 7;
                  end
                else
                  begin
                    ch := 6;
                    cl := 7;
                  end;
              end;
          end; {if}
          if not on then
            ch := ch or $20; {cursor off}
          ah := 1; {set cursor type}
          intr($10, regs);
        end; {with}
    end; {cursor}

procedure open_files;
var
   infname      :  string[20];
   outfname     :  string[20];
   ans          :  string[10];
   goodfile     :  boolean;

begin {open_files}
     window (1,5,80,25);
     repeat
        ClrScr;
        write ('Input filename  -->  ');
        readln (infname);
        if infname = '' then
          begin
            window(1,1,80,25);
            clrscr;
            halt;
          end;
        assign(infile,infname);
        {$I-} reset(infile) {$I+};
        goodfile := (IOresult = 0);
        if not goodfile then
        begin
          write (chr(bell));
          writeln ('FILE ',infname,' NOT FOUND');
          delay(3000)
        end;
     until goodfile;
     window (1,6,80,25);
     repeat
        ClrScr;
        write ('Output filename -->  ');
        readln (outfname);
        assign (outfile,outfname);
        {$I-} reset(outfile) {$I+};
        goodfile := (IOresult <> 0);
        if not goodfile then
        begin
          write (chr(bell));
          write ('FILE ',outfname,' EXISTS, OVERWRITE? (y/n) ');
          readln (ans);
          goodfile := (UpCase(ans[1])='Y')
        end;
     until goodfile;
     rewrite(outfile)
end; {open_files}

procedure get_line;
var
   ch    : char;
   num   : byte;
   lonum : byte;

begin
  ch:=chr(0);
  lonum:=0;
  num:=0;
  cnt:=0;

  while not eof(infile) and (lonum<>lf) do
  begin
    cnt:=cnt+1;
    read(infile,ch);
    totchrin := totchrin + 1;
    num:=ord(ch);
    lonum:=(num and 127);
    numlist[cnt]:=num;
  end
end;

procedure test_line;
begin
     translt := true;
     if stripdc then
       if numlist[1]=period then translt := false;
end;

procedure translate_line;
var
   spstr  :  string[10];
   indx1  :  integer;
   indx2  :  integer;
   indx3  :  integer;
   num    :  byte;
   chnum  :  byte;
   lonum  :  byte;
   exch   :  boolean;

begin
  for indx1:=1 to cnt do
  begin
    exch := false;
    num:=numlist[indx1];
    chnum := num and 127;
    lonum :=chnum;

    if (num=softhyph2) then
       chnum := hyph
    else if (num=softhyph1) then
       chnum := null;

    if num=nobrksp then chnum := space;

    if chgpc then
    begin
      for indx2:=1 to pc do
      begin
        if lonum = spc[indx2] then
        begin
          chnum := null;
          exch := true;
          if flagpc[indx2] then
            spstr := pcoff[indx2]
          else
            spstr := pcon[indx2];
          flagpc[indx2] := not flagpc[indx2]
        end
      end
    end;

    if stripsp and (num=softsp) then chnum := null;
    if striplf and (lonum=lf) then chnum := null;

    if strippc then
      for indx3 := 1 to pc do
        if lonum = spc[indx3] then chnum := null;

    if chnum <> null then
    begin
      write (outfile, chr(chnum));
      totchrout := totchrout+1
    end;
    if exch then
    begin
      write(outfile,spstr);
      totchrout := totchrout + length(spstr)
    end
  end
end;

function inyn : boolean;
var
  ans  : string[10];

begin
  write('[y/n] ');
  readln(ans);
  inyn := (Upcase(ans[1]) = 'Y')
end;

procedure menu;
begin
      writeln;
      writeln('Wordstar to ASCII Conversion');
      writeln;
      writeln;
      write(' 1.  Strip soft-spaces (un-justify)?   ');
      stripsp := inyn;
      write(' 2.  Strip line feeds?                 ');
      striplf := inyn;
      write(' 3.  Change control (print) commands?  ');
      chgpc   := inyn;
      write(' 4.  Strip dot commands?               ');
      stripdc := inyn;
      if chgpc = false then
      begin
        write(' 5.  Strip print commands?             ');
        strippc := inyn;
      end
      else
        strippc := false;
      writeln;
      write(' Quit?                                 ');
      quit := inyn;
end;

procedure process;
var
   line  :  integer;
   indx  :  integer;

begin {process}
     window(1,7,80,25);
     ClrScr;
     line:=0;
     totchrin:=0;
     totchrout:=0;

     for indx :=1 to pc do
       flagpc[indx] := false;

     cursor(false,false);
     while not eof(infile) do
     begin
        line:=line+1;
        get_line;
        test_line;
        if translt then
          begin
            translate_line;
            window(1,12,80,16);
            gotoxy(1,1);
            write('Line # ',line:5);
            gotoxy(1,2);
            write('Total characters input:    ',totchrin:6:0);
            gotoxy(1,3);
            write('Total characters output:   ',totchrout:6:0);
            gotoxy(1,4);
            write('Total filtered(+)/added(-):',(totchrin-totchrout):6:0);
          end
     end
end;

procedure exit;
begin
     window(1,23,80,25);
     ClrScr;
     cursor(true, false);
     writeln('Translation completed!');
(*
     writeln(outfile);
*)
     close(infile);
     write(outfile, ^Z); {BLE 11-05-85}
     close(outfile)
end;

begin
     ClrScr;
     writeln;
     writeln('WordStar File Conversion Program');
     writeln('Copyright 1985 by David W. Carroll');
     writeln('Version #',version,' of ',date,'.');
     writeln;
     window(1,5,80,25);
     ClrScr;
     menu;
     ClrScr;
     if not quit then
     begin
       open_files;
       process;
       exit
     end
     else
       writeln('Translation cancelled.');
end.