home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / JTTLIB.ZIP / PRETTY.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-02-04  |  5.7 KB  |  244 lines
  1. Program Pretty;
  2. {$V-,C-}
  3.  
  4. Const
  5.   Cap_Set: Set Of Char = [' ','_','(','[','.',',','=','+','-','*','/','\',':','$'];
  6.   Work_Fn = 'PTY_TEMP.WRK';
  7.  
  8. Type
  9.   Str6 = String[6];
  10.   Str8 = String[8];
  11.   Str12 = String[12];
  12.   Str15 = String[15];
  13.   Str25 = String[25];
  14.   Str80 = String[80];
  15.   Str132 = String[132];
  16.   Str255 = String[255];
  17.  
  18. Var
  19.   In_Fn, Out_Fn : Str25;
  20.   In_Fl, Out_Fl : Text[$1000];
  21.   Err : Integer;
  22.   Ioerr : Integer;
  23.  
  24. Procedure Lc(Var Ch1 : Char);
  25.  
  26. Begin
  27.   If (Ch1 in ['A'..'Z']) then Ch1 := Chr(Ord(Ch1)+32);
  28. End;
  29.  
  30. Function Exist(F : Str25) : Boolean;
  31. Var Fil : File;
  32.  
  33. Begin
  34.   Exist := True;
  35.   Assign(Fil,F);
  36. {$I-}
  37.   Reset(Fil);
  38. {$I+}
  39.   Exist := (Ioresult = 0);
  40.   Close(Fil);
  41. End;
  42.  
  43. Procedure Clrpos(First, Last : Byte);
  44. Var Line : Byte;
  45.  
  46. Begin
  47.   For Line := First to Last Do
  48.     Begin
  49.       Gotoxy(1,Line);
  50.       Clreol;
  51.     End;
  52.   Gotoxy(1,Line);
  53. End;
  54.  
  55. Function Get_Filename(Present : Boolean; Ext : Str6) : Str25;
  56. {returns an acceptable filename.  present indicates whether it must already
  57.  exist or be a new file; ext is an optional extension that will be added if
  58.  it has length > 0.                                                        }
  59. Var Ch : Char;
  60.     St : Str25;
  61.     There : Boolean;
  62.     Xhold, Yhold : Byte;
  63.     L : Byte;
  64.     Ok : Boolean;
  65.  
  66. Begin
  67.   Xhold := Wherex;
  68.   Yhold := Wherey;
  69.   Repeat
  70.     Ok := True;
  71.     Gotoxy(Xhold,Yhold);
  72.     Clreol;
  73.     Readln(St);
  74.     If (St = '') then St := '  ';
  75.     If (Length(Ext) >= 1) then If (Pos('.',St) = 0) then St := Concat(St,Ext);
  76.     For L := 1 to Length(St) Do
  77.     If not (St[L] in ['A'..'Z','a'..'z','.',':','\','0'..'9','_']) Then
  78.       Ok := False;
  79.     If (St[1] in ['0'..'9','.']) then Ok := False;
  80.     If Ok Then
  81.       Begin
  82.         There := Exist(St);
  83.         If There <> Present Then
  84.           Begin
  85.             Gotoxy(1,Yhold+2);
  86.             Clreol;
  87.             Write(Chr(7));
  88.             If There Then
  89.               Begin
  90.                 Write('File exists already.  Overwrite (Y/N) ? ');
  91.                 Repeat
  92.                   Read(Kbd,Ch);
  93.                   Ch := Upcase(Ch);
  94.                 Until Ch in ['Y','N'];
  95.                 If Ch = 'Y' then There := Present;
  96.               End
  97.             else Write('Error - file not found');
  98.             Delay(1000);
  99.             Gotoxy(1,Yhold+2);
  100.             Clreol;
  101.           End;
  102.       End
  103.     else
  104.       Begin
  105.         Gotoxy(1,Yhold+2);
  106.         Clreol;
  107.         There := not Present;
  108.         Write(Chr(7),'Error - invalid file name');
  109.         Delay(1000);
  110.         Gotoxy(1,Yhold+2);
  111.         Clreol;
  112.       End;
  113.   Until There = Present;
  114.   Get_Filename := St;
  115. End;
  116.  
  117. Procedure Get_In_File;
  118. Var Numpar : Byte;
  119.     L : Byte;
  120.     Ok : Boolean;
  121.  
  122. Begin
  123.   Numpar := Paramcount;
  124.   If (Numpar > 0) Then
  125.     Begin
  126.       In_Fn := Paramstr(1);
  127.       Ok := True;
  128.       For L := 1 to Length(In_Fn) Do
  129.       If not (In_Fn[L] in ['A'..'Z','a'..'z','.',':','\','0'..'9','_']) Then
  130.       Ok := False;
  131.       If (In_Fn[1] in ['0'..'9','.']) then Ok := False;
  132.       If Ok then Ok := Exist(In_Fn);
  133.       If not Ok Then
  134.         Begin
  135.           Gotoxy(1,8);
  136.           Clreol;
  137.           Write('Input file name : ');
  138.           In_Fn := Get_Filename(True,'');
  139.         End;
  140.     End
  141.   else
  142.     Begin
  143.       Write('This program alters case appropriately in the input source');
  144.       Writeln(' text file.');
  145.       Gotoxy(1,8);
  146.       Write('Input file name : ');
  147.       In_Fn := Get_Filename(True,'');
  148.     End;
  149.   Assign(In_Fl,In_Fn);
  150.   Rename(In_Fl,Work_Fn);
  151.   Assign(Out_Fl,In_Fn);
  152. End;
  153.  
  154. Procedure Special_Lower(Var Inst: Str255; Wrd : Str8);
  155. Var Place : Integer;
  156.     Letter : Integer;
  157.     Quote : Boolean;
  158.  
  159. Begin
  160.   Place := Pos(Wrd,Inst);
  161.   If (Place <> 0) Then
  162.   Repeat
  163.     Quote := False;
  164.     Begin
  165.       For Letter := 1 to Place Do
  166.       If (Inst[Letter] in ['''']) then Quote := not Quote;
  167.       If (Not Quote) then For Letter := Place to (Place+1) Do
  168.       Lc(Inst[Letter]);
  169.       Place := Pos(Wrd,Inst);
  170.     End;
  171.   Until (Place = 0) or Quote;
  172. End;
  173.  
  174. Procedure Change_Case;
  175. Var L, P : Integer;
  176.     In_Line : Str255;
  177.     Quote, Cap : Boolean;
  178.  
  179. Begin
  180.   Rewrite(Out_Fl);
  181.   Gotoxy(1,10);
  182.   Clreol;
  183.   Write('Working...');
  184.   Reset(In_Fl);
  185.   Ioerr := 0;
  186.   While (Ioerr = 0) and (Not Eof(In_Fl)) Do
  187.     Begin
  188.       Readln(In_Fl,In_Line);
  189.       Cap := True;
  190.       For P := 1 to Length(In_Line) Do
  191.         Begin
  192.           If (In_Line[P] in ['''','{','}']) then Quote := not Quote;
  193.           If (Not Quote) Then
  194.             Begin
  195.               If (Not Cap) then Lc(In_Line[P])
  196.               else In_Line[P] := Upcase(In_Line[P]);
  197.               If (In_Line[P] in Cap_Set) Then
  198.               Cap := True
  199.                 else Cap := False;
  200.             End;
  201.         End;
  202.       Special_Lower(In_Line,' Then ');
  203.       Special_Lower(In_Line,' Do ');
  204.       Special_Lower(In_Line,' In ');
  205.       Special_Lower(In_Line,' Else');
  206.       Special_Lower(In_Line,' And ');
  207.       Special_Lower(In_Line,' Or ');
  208.       Special_Lower(In_Line,' Not ');
  209.       Special_Lower(In_Line,' To ');
  210.       Special_Lower(In_Line,' Downto ');
  211.       Writeln(Out_Fl,In_Line);
  212.     End;
  213.   If (Ioerr = 0) Then
  214.     Begin
  215.       {$I-}
  216.       Close(In_Fl);
  217.       Erase(In_Fl);
  218.       Flush(Out_Fl);
  219.       {$I+}
  220.       Ioerr := Ioresult;
  221.       Close(Out_Fl);
  222.       If (Ioerr <> 0) Then
  223.         Begin
  224.           Erase(Out_Fl);
  225.           Rename(In_Fl,In_Fn);
  226.           Writeln;
  227.           Writeln('Error - Disk full');
  228.         End;
  229.     End;
  230. End;
  231.  
  232. Begin
  233.   Clrscr;
  234.   Gotoxy(15,1);
  235.   Writeln('= = P A S C A L   P R E T T Y   F O R M A T T E R = =');
  236.   Gotoxy(1,6);
  237.   Get_In_File;
  238.   Clrpos(2,13);
  239.   Gotoxy(1,4);
  240.   Write('Changing ',In_Fn);
  241.   Change_Case;
  242. End.
  243.  
  244.