home *** CD-ROM | disk | FTP | other *** search
/ The Equalizer BBS / equalizer-bbs-collection_2004.zip / equalizer-bbs-collection / DEMOSCENE-STUFF / BUDYN1.ZIP / NAW.ZIP / NAW.PAS < prev   
Pascal/Delphi Source File  |  1996-05-15  |  5KB  |  191 lines
  1. {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. {$M 1024,0,0}
  3. { Texts' corrector for articles given to any mag. }
  4. { Author: Astra / Absence. This is freeware! Spread it! }
  5.  
  6. uses Dos;
  7.  
  8. var
  9.    f1, f2: Text;
  10.    n1, n2: string;
  11.    st,mth: string;
  12.        cn: Byte;
  13.       dir: SearchRec;
  14.  
  15.  
  16. function IsMark(ch: char): Boolean;
  17. begin
  18.    if (ch<>'!') and (ch<>';') and (ch<>'?') and (ch<>',') and (ch<>'.') and
  19.       (ch<>':') then IsMark := True
  20.    else IsMark := False;
  21. end;
  22.  
  23.  
  24. procedure CorrectChars;
  25. begin
  26.      while Pos(#9, st)<>0 do
  27.      begin
  28.            for cn := 0 to (7-(Pos(#9, st)-1) mod 8) do
  29.                Insert(' ', st, Pos(#9, st)+1);
  30.            Delete(st, Pos(#9, st), 1);
  31.      end;
  32.      while Pos(#255, st)<>0 do
  33.            st[Pos(#255, st)]:=' ';
  34. end;
  35.  
  36.  
  37. procedure CorrectBrackets(b1, b2: Char);
  38. begin
  39.      cn := 1;
  40.      repeat
  41.            if st[cn] = b1 then
  42.               if (cn <> Length(st)) then
  43.                  while (st[cn + 1]=' ') do
  44.                        Delete(st, cn + 1, 1);
  45.            if st[cn]=b2 then
  46.               if (cn <> 1) then
  47.                  while (st[cn-1]=' ') do
  48.                  begin
  49.                       Delete(st, cn - 1, 1);
  50.                       Dec(cn);
  51.                  end;
  52.            Inc(cn);
  53.      until (cn > Length(st));
  54. end;
  55.  
  56.  
  57. procedure CorrectMarks;
  58. var
  59.    mark: Boolean;
  60. begin
  61.      mark := False;
  62.      cn := 1;
  63.      repeat
  64.            if st[cn]='"' then
  65.               case mark of
  66.                    False:
  67.                         if (cn <> Length(st)) then
  68.                            while (st[cn + 1]=' ') do
  69.                                 Delete(st, cn + 1, 1);
  70.                    True:
  71.                         if (cn <> 1) then
  72.                            while (st[cn-1]=' ') do
  73.                            begin
  74.                                 Delete(st, cn - 1, 1);
  75.                                 Dec(cn);
  76.                            end;
  77.               end;
  78.            Mark := not Mark;
  79.            Inc(cn);
  80.      until (cn > Length(st));
  81. end;
  82.  
  83.  
  84. procedure CorrectSpaces;
  85. begin
  86.      cn := 1;
  87.      repeat
  88.            while (st[cn]<>' ') and (cn< Length(st)) do
  89.                  Inc(cn);
  90.            while (st[cn + 1]=' ') and (cn< Length(st)) do
  91.                  Delete(st, cn + 1, 1);
  92.  
  93.            Inc(cn);
  94.      until (cn >= Length(st));
  95. end;
  96.  
  97.  
  98. procedure CorrectCommas;
  99. begin
  100.      cn := 1;
  101.      repeat
  102.            case st[cn] of
  103.            '!',';','?',',','.',':':
  104.                                begin
  105.                                     while (st[cn - 1]=' ') do
  106.                                     begin
  107.                                          Delete(st, cn - 1, 1);
  108.                                          Dec(cn);
  109.                                     end;
  110.                                     if (st[cn + 1] <> ' ') and (cn <> Length(st))
  111.                                        and not IsMark(st[cn + 1]) then
  112.                                        Insert(' ', st, cn + 1);
  113.                                end;
  114.            end;
  115.            Inc(cn);
  116.      until (cn > Length(st));
  117. end;
  118.  
  119.  
  120. procedure CorrectMinus;
  121. begin
  122.      cn := 1;
  123.      repeat
  124.            while (st[cn]<>'-') and (cn <= Length(st)) do
  125.                  Inc(cn);
  126.            if (cn <> 1) and (cn <= Length(st)) and (st[cn - 1] <> ' ') then
  127.               Insert(' ', st, cn - 1);
  128.            if (cn < Length(st)) and (st[cn +1] <> ' ') then
  129.               Insert(' ', st, cn + 1);
  130.            Inc(cn);
  131.      until (cn > Length(st));
  132. end;
  133.  
  134.  
  135. procedure ProcessLine;
  136. begin
  137.      ReadLn(f1, st);
  138.    {  CorrectSpaces;              }     {zbedna ilosc spacji}
  139.    {  CorrectBrackets('(',')');   }     {przyklejenie ()}
  140.    {  CorrectBrackets('[',']');   }     {przyklejenie []}
  141.    {  CorrectBrackets('<','>');   }     {przyklejenie <>}
  142.    {  CorrectCommas;              }     {koreksja znakow przest.}
  143.    {  CorrectMarks;               }     {korekta cudzyslowow ""}
  144.    {  CorrectMinus;               }     {dodanie spacji przy minusie}
  145.      CorrectChars;                     {zlikwidowanie TAB i #255}
  146.      WriteLn(f2, st);
  147. end;
  148.  
  149.  
  150. procedure ProcessFile;
  151. begin
  152.      n2:=n1;
  153.      Delete(n2,Pos('.',n2),4);
  154.      n2 := n2 + '.naw';
  155.      Assign(f1, n1);
  156.      Assign(f2, n2);
  157.      Reset(f1);
  158.      Rewrite(f2);
  159.      Writeln(n1);
  160.      while (not Eof(f1)) do
  161.            ProcessLine;
  162.      Close(f2);
  163.      Close(f1);
  164. end;
  165.  
  166.  
  167. begin
  168.      if (ParamCount <> 1) then Halt;
  169.      if (Pos('*',ParamStr(1))<>0) then
  170.      begin
  171.           mth := ParamStr(1);
  172.           FindFirst(mth, AnyFile, dir);
  173.           if (DosError <> 0) then Halt;
  174.           while (DosError = 0) do
  175.           with dir do
  176.           begin
  177.                if (Attr and Directory = 0) and (Attr and VolumeID = 0) then
  178.                begin
  179.                     n1 := Name;
  180.                     ProcessFile;
  181.                end;
  182.                FindNext(dir);
  183.           end;
  184.      end
  185.      else
  186.      begin
  187.          n1 := ParamStr(1);
  188.          ProcessFile;
  189.      end;
  190. end.
  191.