home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / xref / wsmsj5.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-06-05  |  6.9 KB  |  301 lines
  1. program wsutil;
  2.  
  3. {WordStar file utility  --  3-27-85 Ver B5   }
  4. {Copyright 1985 by David W. Carroll          }
  5. {                                            }
  6. {Converts WordStar files to ASCII text files }
  7. {with options.                               }
  8.  
  9. {Written for Turbo Pascal Corner column in
  10.  Micro/Systems Journal, May/June 1985 }
  11.  
  12. const
  13.    nummax      = 200;   {Maximum input line length}
  14.  
  15.    version     = 'B5';
  16.    date        = 'March 27, 1985';
  17.  
  18.    null        = 00;
  19.    bell        = 07;
  20.    lf          = 10;
  21.    ff          = 12;
  22.    cr          = 13;
  23.    nobrksp     = 15;   {no break space ^O}
  24.    softhyph1   = 30;   {mid-text soft hyphen}
  25.    softhyph2   = 31;   {eol soft hyphen}
  26.    space       = 32;
  27.    hyph        = 45;
  28.    period      = 46;
  29.    softlf      = 138;  {soft line feed}
  30.    softcr      = 141;  {soft carriage return}
  31.    softsp      = 160;  {soft space}
  32.  
  33.    ctlb        = 02;
  34.    ctld        = 04;
  35.    ctls        = 19;
  36.    ctlt        = 20;
  37.    ctlv        = 22;
  38.  
  39. { arrays pcon and pcoff contain the strings that are  }
  40. { substituted for WordStar print control characters   }
  41. { ^b, ^d, ^s, ^t, and ^v. Constant pc is the total    }
  42. { number of WS print control characters supported.    }
  43.  
  44.    pc          = 05;
  45.    spc:   array[1..pc] of byte = (ctlb, ctld, ctls, ctlt, ctlv);
  46.    pcon:  array[1..pc] of string[10] =
  47.             ('[bf]','[ds]','[us]','[sup]','[sub]');
  48.    pcoff: array[1..pc] of string[10] =
  49.             ('[ebf]','[eds]','[eus]','[esup]','[esub]');
  50.  
  51. var
  52.    infile       :  text;
  53.    outfile      :  text;
  54.    numlist      :  array[1..nummax] of byte;
  55.    flagpc       :  array[1..pc] of boolean;
  56.    totchrin     :  real;
  57.    totchrout    :  real;
  58.    cnt          :  integer;
  59.    quit         :  boolean;
  60.    stripsp      :  boolean;
  61.    striplf      :  boolean;
  62.    chgpc        :  boolean;
  63.    stripdc      :  boolean;
  64.    strippc      :  boolean;
  65.    translt      :  boolean;
  66.  
  67. procedure open_files;
  68. var
  69.    infname      :  string[20];
  70.    outfname     :  string[20];
  71.    ans          :  string[10];
  72.    goodfile     :  boolean;
  73.  
  74. begin
  75.      window (1,5,80,25);
  76.      repeat
  77.         ClrScr;
  78.         write ('Input filename  -->  ');
  79.         readln (infname);
  80.         assign(infile,infname);
  81.         {$I-} reset(infile) {$I+};
  82.         goodfile := (IOresult = 0);
  83.         if not goodfile then
  84.         begin
  85.           write (chr(bell));
  86.           writeln ('FILE ',infname,' NOT FOUND');
  87.           delay(3000)
  88.         end;
  89.      until goodfile;
  90.      window (1,6,80,25);
  91.      repeat
  92.         ClrScr;
  93.         write ('Output filename -->  ');
  94.         readln (outfname);
  95.         assign (outfile,outfname);
  96.         {$I-} reset(outfile) {$I+};
  97.         goodfile := (IOresult <> 0);
  98.         if not goodfile then
  99.         begin
  100.           write (chr(bell));
  101.           write ('FILE ',outfname,' EXISTS, OVERWRITE? (y/n) ');
  102.           readln (ans);
  103.           goodfile := (UpCase(ans[1])='Y')
  104.         end;
  105.      until goodfile;
  106.      rewrite(outfile)
  107. end;
  108.  
  109. procedure get_line;
  110. var
  111.    ch    : char;
  112.    num   : byte;
  113.    lonum : byte;
  114.  
  115. begin
  116.   ch:=chr(0);
  117.   lonum:=0;
  118.   num:=0;
  119.   cnt:=0;
  120.  
  121.   while not eof(infile) and (lonum<>lf) do
  122.   begin
  123.     cnt:=cnt+1;
  124.     read(infile,ch);
  125.     totchrin := totchrin + 1;
  126.     num:=ord(ch);
  127.     lonum:=(num and 127);
  128.     numlist[cnt]:=num;
  129.   end
  130. end;
  131.  
  132. procedure test_line;
  133. begin
  134.      translt := true;
  135.      if stripdc then
  136.        if numlist[1]=period then translt := false;
  137. end;
  138.  
  139. procedure translate_line;
  140. var
  141.    spstr  :  string[10];
  142.    indx1  :  integer;
  143.    indx2  :  integer;
  144.    indx3  :  integer;
  145.    num    :  byte;
  146.    chnum  :  byte;
  147.    lonum  :  byte;
  148.    exch   :  boolean;
  149.  
  150. begin
  151.   for indx1:=1 to cnt do
  152.   begin
  153.     exch := false;
  154.     num:=numlist[indx1];
  155.     chnum := num and 127;
  156.     lonum :=chnum;
  157.  
  158.     if (num=softhyph2) then
  159.        chnum := hyph
  160.     else if (num=softhyph1) then
  161.        chnum := null;
  162.  
  163.     if num=nobrksp then chnum := space;
  164.  
  165.     if chgpc then
  166.     begin
  167.       for indx2:=1 to pc do
  168.       begin
  169.         if lonum = spc[indx2] then
  170.         begin
  171.           chnum := null;
  172.           exch := true;
  173.           if flagpc[indx2] then
  174.             spstr := pcoff[indx2]
  175.           else
  176.             spstr := pcon[indx2];
  177.           flagpc[indx2] := not flagpc[indx2]
  178.         end
  179.       end
  180.     end;
  181.  
  182.     if stripsp and (num=softsp) then chnum := null;
  183.     if striplf and (lonum=lf) then chnum := null;
  184.  
  185.     if strippc then
  186.       for indx3 := 1 to pc do
  187.         if lonum = spc[indx3] then chnum := null;
  188.  
  189.     if chnum <> null then
  190.     begin
  191.       write (outfile, chr(chnum));
  192.       totchrout := totchrout+1
  193.     end;
  194.     if exch then
  195.     begin
  196.       write(outfile,spstr);
  197.       totchrout := totchrout + length(spstr)
  198.     end
  199.   end
  200. end;
  201.  
  202. function inyn : boolean;
  203. var
  204.   ans  : string[10];
  205.  
  206. begin
  207.   write('[y/n] ');
  208.   readln(ans);
  209.   inyn := (Upcase(ans[1]) = 'Y')
  210. end;
  211.  
  212. procedure menu;
  213. begin
  214.       writeln;
  215.       writeln('Wordstar to ASCII Conversion');
  216.       writeln;
  217.       writeln;
  218.       write(' 1.  Strip soft-spaces (un-justify)?   ');
  219.       stripsp := inyn;
  220.       write(' 2.  Strip line feeds?                 ');
  221.       striplf := inyn;
  222.       write(' 3.  Change control (print) commands?  ');
  223.       chgpc   := inyn;
  224.       write(' 4.  Strip dot commands?               ');
  225.       stripdc := inyn;
  226.       if chgpc = false then
  227.       begin
  228.         write(' 5.  Strip print commands?             ');
  229.         strippc := inyn;
  230.       end
  231.       else
  232.         strippc := false;
  233.       writeln;
  234.       write(' Quit?                                 ');
  235.       quit := inyn;
  236. end;
  237.  
  238. procedure process;
  239. var
  240.    line  :  integer;
  241.    indx  :  integer;
  242.  
  243. begin
  244.      window(1,7,80,25);
  245.      ClrScr;
  246.      line:=0;
  247.      totchrin:=0;
  248.      totchrout:=0;
  249.  
  250.      for indx :=1 to pc do
  251.        flagpc[indx] := false;
  252.  
  253.      while not eof(infile) do
  254.      begin
  255.         line:=line+1;
  256.         get_line;
  257.         test_line;
  258.         if translt then
  259.           begin
  260.             translate_line;
  261.             window(1,12,80,16);
  262.             ClrScr;
  263.             writeln('Line # ',line:5);
  264.             writeln('Total characters input:    ',totchrin:6:0);
  265.             writeln('Total characters output:   ',totchrout:6:0);
  266.             writeln('Total filtered(+)/added(-):',(totchrin-totchrout):6:0);
  267.           end
  268.      end
  269. end;
  270.  
  271. procedure exit;
  272. begin
  273.      window(1,23,80,25);
  274.      ClrScr;
  275.      writeln('Translation completed!');
  276.      writeln(outfile);
  277.      close(infile);
  278.      close(outfile)
  279. end;
  280.  
  281. begin
  282.      ClrScr;
  283.      writeln;
  284.      writeln('WordStar File Conversion Program');
  285.      writeln('Copyright 1985 by David W. Carroll');
  286.      writeln('Version #',version,' of ',date,'.');
  287.      writeln;
  288.      window(1,5,80,25);
  289.      ClrScr;
  290.      menu;
  291.      ClrScr;
  292.      if not quit then
  293.      begin
  294.        open_files;
  295.        process;
  296.        exit
  297.      end
  298.      else
  299.        writeln('Translation cancelled.');
  300. end.
  301.