home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / STRIP12.PQS / STRIP12.PAS
Pascal/Delphi Source File  |  2000-06-30  |  13KB  |  354 lines
  1. program stripper;
  2.  
  3. { V1.2, 850912 - Modified to allow for files that don't end with a
  4.   ^Z.  (Hangs up otherwise.)
  5.  
  6.   850820 - Modified to tabify ONLY if the space-filled blank is more
  7.   than 4 chars long, and/or NOT following a non-space character with
  8.   the 8th bit set (WS's way of marking a right-justify space.
  9.   (BIG problems in WS-formatted document files.)
  10.  
  11.   850725, Toad Hall.  Author (?) David P Kirschbaum.
  12.   Used the guts of a public domain hex conversion program
  13.   (HEXTOBIN.PAS) for the structure, stuffed in a stripped down
  14.   tabify routine from TURBTOOLS (another PD library), added the
  15.   command line processing (source forgotten, but PD).
  16.   Many thanks to the other Public Domain authors.  I regret I can't
  17.   give your names here - my software library is such a mishmash of
  18.   chunks and pieces!
  19.  
  20.   Simple little program to process WordStar files (with all their
  21.   hi-bit flagged characters) into a nice clean 7-bit file.  As a
  22.   side benefit, Stripper also changes all the long space-filled
  23.   blanks into 8-character tabs.
  24.  
  25.   Because of a problem with some files coming down from weird sources
  26.   (I think certain Vaxen are bad for this) with only carriage returns
  27.   to end lines (yep, no line feeds!), Stripper also forces a CR/LF
  28.   combination whenever it finds a CR.  Unfortunately, it also throws
  29.   out all solitary line feeds.  (Sorry, guys -- just didn't feel like
  30.   screwing about with line feed flags during buffer fills, etc.  Some
  31.   other soul can add that back if they want.)
  32.  
  33.   This file is given to the Public Domain for all uses, public and
  34.   private, with the usual provisos that you (1) leave in any credits and
  35.   version/update comments, and (2) no commercial or "for profit" applications
  36.   or sales without express written permission of the author.  And just to be
  37.   sure (and keep my lawyers content) ....
  38.  
  39.   Copyright (C) 1985 David P Kirschbaum  All Rights Reserved
  40.  
  41.   Toad Hall
  42.   7573 Jennings Lane
  43.   Fayetteville NC  28303
  44.   (919) 868-3471
  45. }
  46.  
  47.  
  48. CONST
  49.   TheHEADER = 'Stripper WS Conversion Program';
  50.   TheVERSION = 'Version 1.2 -- 850912';
  51.   ToadCredits = 'Toad Hall TurboPascal conversion.';
  52.   TheCount = ' sectors converted.';
  53.   SpaceCount = ' spaces converted.';
  54.   TrailingCount = ' trailing spaces stripped.';
  55.   TheTRAILER = 'Stripping done.  Ribbet.';
  56.   HarType    = '.HAR';
  57.   maxrecs    = 64;             {64 recs per bufferful}
  58.   maxline    = 128;            {max length of a line for us}
  59.   mintab     = 4;              {min # spaces before we tabify}
  60.   buffsize   = 8192;           {maxrecs * maxline or 128-byte rec}
  61.   tabspace   = 8;              {make a tab 8 spaces for entab - fits WS}
  62.   Tab        : CHAR = #9;      {tab char Ctrl I}
  63.   Space      : CHAR = ' ';     {regular space}
  64.   Cr         : CHAR = #13;     {carriage return char}
  65.   Lf         : CHAR = #10;     {line feed char}
  66.   spaceval   = 32;             {ASCII for space}
  67.   crval      = 13;             {carriage return}
  68.   lfval      = 10;             {line feed}
  69.   eofval     = 26;             {Ctrl Z}
  70.  
  71. TYPE
  72.   Buffer    = ARRAY [1..buffsize] OF BYTE;   {64 rec, 8 Kb buffer for now}
  73.   Line      = STRING[maxline];               {max length line for us}
  74.   TxtBuffer = ARRAY[1..maxrecs] OF Line;     {64 128-byte lines}
  75.   tabtype   = ARRAY[1..maxline] OF BOOLEAN;  {flags for tab columns}
  76.   FileName  = STRING[14];                    {drive but NOT path in MS-DOS}
  77.                                              {donno HOW yet!}
  78.   Args      = ARRAY[1..2] OF FileName;       {Cmd line parameters}
  79.  
  80. VAR
  81.   Harfilename ,
  82.   WSfilename : FileName;
  83.  
  84.   Argv      : Args;
  85.   { ArgStr    : STRING[80] ABSOLUTE $80;}         {CP/M}
  86.   ArgStr    : STRING[80] ABSOLUTE CSEG : $80;  {MS-DOS}
  87.   WSfile    : FILE;
  88.   Harfile   : TEXT;
  89.  
  90.   WSbuff    : Buffer;
  91.   Strng     : TxtBuffer;
  92.  
  93.   sectorct,
  94.   WSfilesize,
  95.   ip,space_cnt,
  96.   trailing_cnt,
  97.   WSbuffsize : INTEGER;
  98.  
  99.   b,c,ch,s,
  100.   col,newcol,
  101.   argc,reccnt : BYTE;
  102.  
  103.   hiflag      : BOOLEAN;
  104.  
  105.   PROCEDURE DoCmdLine(VAR argc : BYTE; VAR Argv : Args);
  106.  
  107. {This routine performs several functions.  It reads the CP/M command tail
  108.  (if any) and breaks the command tail into Argvs.  An Argv is any string
  109.  of characters delimited by either the beginning of the command tail, the
  110.  end of the command tail, or a space.  The routine returns the Argv count
  111.  (argc, usually), and all Argvs found.
  112.  There are several versions around -- I forget where I got the basic guts
  113.  for this simple one, but somebody else gave me the idea!  [Toad Hall]
  114. }
  115.     VAR
  116.       i, j: INTEGER;
  117.  
  118.     BEGIN
  119.       argc := 0;
  120.       i := 0;
  121.     {if the following is true there is a command tail, otherwise leave
  122.      the count set to 0 and do not parse the command line}
  123.       j := length(ArgStr);
  124.       IF j > 0 THEN BEGIN
  125.         Repeat  {until i = length(ArgStr)}
  126.           i := succ(i);
  127.           IF ArgStr[i] <> Space THEN BEGIN
  128.             argc := succ(argc);
  129.             Argv[argc] := Argv[argc] + UpCase(ArgStr[i]);
  130.             WHILE (ArgStr[i+1] <> Space) AND (i < j) DO BEGIN
  131.               i := succ(i);
  132.               Argv[argc] := Argv[argc] + UpCase(ArgStr[i]);
  133.             END;  {while}
  134.           END;  {if}
  135.         Until i = j;
  136.       END;  {j > 0}
  137.     END;  {of DoCmdLine}
  138.  
  139.  
  140.   FUNCTION OpenInp(VAR WSfilename : FileName) : BOOLEAN;
  141.  
  142.     BEGIN
  143.       OpenInp := TRUE;
  144.       IF argc > 0 THEN BEGIN
  145.         WSfilename := Argv[1];
  146.         Write(WSfilename);
  147.       END
  148.       ELSE BEGIN
  149.         Write('Input File: ');
  150.         Read(WSfilename);
  151.       END;
  152.       Assign(WSfile,WSfilename);
  153.       Reset(WSfile);
  154.       IF Eof(WSfile) THEN BEGIN
  155.         Writeln(' ... file is empty...');
  156.         OpenInp := FALSE;
  157.       END;
  158.     END;  {of OpenInp}
  159.  
  160.  
  161.   FUNCTION OpenOut(VAR Harfilename : FileName) : BOOLEAN;
  162.  
  163.     VAR period,strip : BYTE;
  164.  
  165.     BEGIN
  166.       OpenOut := TRUE;
  167.       IF argc = 2 THEN BEGIN
  168.         Harfilename := Argv[2];
  169.         Write(Harfilename);
  170.       END
  171.       ELSE BEGIN
  172.         Harfilename := WSfilename;
  173.         period := pos('.',Harfilename);
  174.         IF period > 1 THEN BEGIN
  175.           strip := length(Harfilename) - period + 1;
  176.           Delete(Harfilename,period,strip);
  177.         END;
  178.         Harfilename := Harfilename + HarType;
  179.         Write(Harfilename);
  180.       END;
  181.       Assign(Harfile,Harfilename);
  182.       Rewrite(Harfile);
  183.     END;  {of OpenOut}
  184.  
  185.  
  186.   Procedure FillBuff(VAR WSfilesize,WSbuffsize : INTEGER;
  187.                      VAR WSBuff : Buffer);
  188.   {refills buffer, sets various pointers, ec.}
  189.     VAR
  190.       reccnt : INTEGER;
  191.  
  192.     BEGIN
  193.       IF WSfilesize < maxrecs THEN BEGIN       {less than 64 recs left?}
  194.         reccnt := WSfilesize;                  {# recs remaining }
  195.         WSbuffsize := reccnt * 128;
  196.         WSfilesize := 0;                       {all done}
  197.       END  {WSfilesize < 64}
  198.       ELSE BEGIN                          {full 64 recs left so get maximum}
  199.         reccnt := maxrecs;                     {all 64}
  200.         WSbuffsize := buffsize;                {maxrecs (64) * 128}
  201.         WSfilesize := WSfilesize - maxrecs;    {figure new remaining}
  202.       END;  {else}
  203.       Blockread(WSfile,WSBuff,reccnt);         {fill the buffer}
  204.     END;  {fill inbuffer}
  205.  
  206.  
  207.   Procedure FillSpace(VAR col,newcol,s : BYTE; VAR Strng : TxtBuffer);
  208.   {If we were tabifying, fills in the remaining space with real spaces.
  209.    Else puts in all the spaces that were there originally.}
  210.     VAR b : BYTE;
  211.  
  212.     BEGIN
  213.       FOR b := 1 TO newcol DO BEGIN        {...spaces not tabified}
  214.         col := succ(col);                  {bump string pointer}
  215.         Strng[s][col] := Space;            {stick in a space}
  216.       END;  {b loop}
  217.       newcol := 0;                         {reset the tab pointer}
  218.     END;  {FillSpace}
  219.  
  220.  
  221.   Procedure Tabify(VAR col,newcol,s : BYTE;
  222.                    VAR Strng : TxtBuffer;
  223.                    VAR space_cnt : INTEGER);
  224.   {checks tab counter; if time to tab, do it}
  225.     BEGIN
  226.       newcol := succ(newcol);                  {bump tab pointer}
  227.       IF hiflag  THEN FillSpace(col,newcol,s,Strng)
  228.       ELSE IF newcol = tabspace THEN BEGIN     {oops, hit a tab stop}
  229.         col := succ(col);                      {bump the string pointer}
  230.         Strng[s][col] := Tab;                  {stick in a tab}
  231.         space_cnt := space_cnt + newcol;       {add in to space count}
  232.         newcol := 0;                           {reset the tab pointer}
  233.       END;   {hit a tab stop or hi bit flag}
  234.     END;  {tabify}
  235.  
  236.  
  237.   Procedure DoCrLf(VAR col,newcol,s : BYTE;
  238.                    VAR Strng : TxtBuffer);
  239.   {forces line length, resets counters and pointers}
  240.  
  241.     BEGIN
  242.       Strng[s][0] := Chr(col);               {force the length (tricky, no?)}
  243.       s := succ(s);                          {next string}
  244.       col := 0;                              {point to beginning of string}
  245.       newcol := 0;                           {tab pointer too}
  246.     END;   {DoCrLf}
  247.  
  248.  
  249.   Procedure WriteFile(reccnt : BYTE; Strng : TxtBuffer);
  250.   {write full text buffer to new file}
  251.     VAR rec: BYTE;
  252.  
  253.   BEGIN
  254.     FOR rec := 1 TO reccnt DO BEGIN           {always smaller than WS file}
  255.         Writeln(Harfile,Strng[rec]);             {write each string}
  256.         Strng[rec] := '';                        {why not? tho doesn't matter}
  257.     END;  {write maxrec strings}
  258.   END;  {WriteFile}
  259.  
  260.  
  261. {stripper main body begins}
  262. BEGIN
  263.   Writeln(TheHEADER);
  264.   Writeln(TheVERSION);
  265.   Writeln(ToadCredits);
  266.   FOR argc := 1 TO 2 DO Argv[argc] := '';
  267.   DoCmdLine(argc,Argv);
  268.   Repeat until OpenInp(WSfilename);
  269.   Writeln(' ------> File opened.');
  270.   Repeat until OpenOut(Harfilename);
  271.   Writeln(' ------> File opened.');
  272.  
  273.   FOR s := 1 TO maxrecs DO
  274.     Strng[s] := '';                            {initialize strings}
  275.   s := 1;                                      {string counter}
  276.   col := 0;                                    {string col pointer}
  277.   newcol := 0;                                 {tab alt pointer}
  278.   ip := 1;                                     {WS buffer pointer}
  279.   ch := 0;                                     {initialize char ASCII val}
  280.   space_cnt := 0;                              {space counter}
  281.   trailing_cnt := 0;                           {trailing space counter}
  282.   hiflag := FALSE;                             {turn hi bit flag off}
  283.   WSbuffsize := 0;
  284.   WSfilesize := filesize(WSfile);
  285.   sectorct := WSfilesize;
  286.   c := sectorct DIV 8 ;
  287.   Write('KB to process:  ',c : 4,Cr);  {start a counter display}
  288.  
  289. {  WHILE ch <> eofval DO BEGIN}
  290.   Repeat
  291.     IF (ip MOD 1024) = 0 THEN BEGIN    {post progress every Kb}
  292.       c := pred(c);
  293.       Write('Kb to process:  ',c : 4,Cr);
  294.     END;
  295.  
  296.     IF ((ip > WSbuffsize) AND (Eof(WSfile) = FALSE))
  297.       THEN BEGIN                       {time to fill buffer}
  298.       ip := 1;                         {reset buff pointer}
  299.       FillBuff(WSfilesize,WSbuffsize,WSBuff);  {refill buffer}
  300.     END;  {fill inbuffer}
  301.  
  302. {WS marks justified spacing by setting the hi bit of the last non-space
  303.  char prior to a series of spaces.  We do NOT want to do any tabifying
  304.  there because of massive problems later if reformatting.  So just strip
  305.  that 8th bit and set a flag saying NO tabifying.}
  306.  
  307.     ch := WSbuff[ip];
  308.     IF (ch > 127) THEN BEGIN
  309.       hiflag := TRUE;
  310.       ch := ch AND 127;                {strip 8th bit}
  311.     END;
  312.     ip := succ(ip);                    {bump buff pointer}
  313.     IF s = 0 THEN s := 1;              {insure no double write}
  314.  
  315.     CASE ch OF
  316.       spaceval :                       {got a space}
  317.         Tabify(col,newcol,s,Strng,space_cnt); {gotcha, dirty little space}
  318.       crval :
  319.         BEGIN               {handle CRs, LFs be damned}
  320.           trailing_cnt := trailing_cnt + newcol; {add in trailing spaces}
  321.           DoCrLf(col,newcol,s,Strng);  {finalize line}
  322.           hiflag := FALSE;             {turn off hi bit flag}
  323.         END;
  324.       lfval : BEGIN END;               {skip lf's}
  325.       ELSE BEGIN                       {not end of line}
  326.         IF newcol > 0 THEN             {process any left over...}
  327.           FillSpace(col,newcol,s,Strng); {...spaces not tabified}
  328.         hiflag := FALSE;
  329.         col := succ(col);              {bump string pointer}
  330.         Strng[s][col] := Chr(ch);      {put in the stripped old char}
  331.       END;  {not end of line}
  332.     END;  {case}
  333.  
  334.     IF (s > maxrecs) THEN BEGIN        {string buffer full}
  335.       WriteFile(maxrecs,Strng);        {write text buffer to file}
  336.       s := 0;                          {reset string counter}
  337.     END;  {do maxrec strings}
  338.     ch := WSbuff[ip];                  {in case a ^Z coming}
  339.  { END; }  {while not eof}                {sure hope it's in this buff}
  340.   Until (Eof(WSFile) AND (ip > WSbuffsize));
  341.  
  342.   IF s > 0 THEN                        {any leftover strings?}
  343.     WriteFile(s,Strng);                {write to file}
  344.   c := pred(c);                        {count down last Kb to... }
  345.   Writeln('Kb to process:  ',c : 4,Cr);  {...make them happy}
  346.   Close(Harfile);                      {shut down}
  347.   Close(WSfile);
  348.   Writeln(sectorct,TheCount);          {brag a little}
  349.   Writeln(space_cnt,SpaceCount);
  350.   Writeln(trailing_cnt, TrailingCount);
  351.   Writeln(TheTRAILER);                 {bye}
  352. END.
  353. 
  354.