home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / UPCONV14.ZIP / UPCONV14.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-10-11  |  19.2 KB  |  537 lines
  1. {$R-,S-,I+,D-,F-,V-,B-,N-,L+ }
  2. {$M 4096,0,0 }
  3. PROGRAM UpConv;
  4. USES Crt,
  5.      Dos;
  6. {
  7.  Original based on a bulletin board program by Jeff Firestone
  8.  This version based on a program by Douglas S. Stivison in his book:
  9.      'Turbo Pascal Library' published by Sybex.
  10.  
  11.   v1.4, Thanks to
  12.  
  13.       Radiometer Analytical A/S
  14.       Krogshojvej 49
  15.       DK-2880 Bagsvaerd
  16.       Denmark
  17.  
  18.     - Spelling corrected. More words added: Turbo 5.5.
  19.  
  20.   Niels Kristian Jensen, 1990.
  21.  
  22.   v1.3, Lyngby, Denmark Dec 1988.
  23.     - Bugs corrected:
  24.       Screen left hilighted. TurboPas 3 bug??
  25.       Counted lines incorrectly.
  26.       Quoted strings in "(* ... *)" comments could cause trouble.
  27.       The prog didn't issue INT $28's when waiting. INT $28 is needed to
  28.       make DOS PRINT work. INT $28 should ALLWAYS ALLLWAAYS be used instead
  29.       of 'busy waiting'. (INT $28 is DOS idle interrupt)
  30.  
  31.     Added features:
  32.     "/F" switch:
  33.        Every identifier is spelled like the first time it appers in the file.
  34.        Units & include files not supported.
  35.  
  36.        More words added.
  37.  
  38.     Comment:
  39.        Downloaded from TRICKLE AT DKTC11 (BITNET), thanks to TURGUT AT TREARN
  40.  
  41.     Niels Kristian Jensen & Lars Riemer,
  42.     Technical Uni of Denmark.
  43.     MSTCOM@NEUVM1.BITNET
  44.  
  45.   v1.2, Toad Hall, 12 Oct 88
  46.     - Bug in Scan_Till procedure.  Fixed.
  47.     - Isn't leaving quoted strings alone.  Fixed.
  48.  
  49.   v1.1 Toad Hall Tweak, Sep 88
  50.     - Added command line filename input.
  51.     - Moved Identifier char set to a global typed constant.
  52.     - Changed simple Reserved Word uppercasing to include Turbo Pascal
  53.       formatted reserved words.
  54.     - Added more reserved words for Turbo Pascal.  (Complete thru v3.0,
  55.       I think .. don't have 4.0, so that should be added.)
  56.     - Command line switch ('-U') to force all reserved words to uppercase
  57.       (e.g., ignore Turbo Pascal format).
  58.     - Considering how to change other text (non-quoted, non-comments)
  59.       to all-upper, all-lower, As-Is, like PFORMAT.PAS does.
  60.     - Still suspect a fancy hash procedure to confirm a RamWord as a
  61.       reserved word would be better than this "if word is in line"
  62.       business.  Later.
  63.   One peculiarity about the comment-handling:  Anything within the usual
  64.   '}{' comments is skipped over; anything within the "parenthesis asterisk"
  65.   type comment IS processed!  So .. put real comments within '}{' comments,
  66.   and commented-out code within the '(* *)' type comments.
  67.  
  68.   v1.0
  69.     - Found in SIMTEL20's PD1:<MSDOS.TURBOPAS>UPCONV.ARC.
  70.       Original author unknown.
  71.  
  72.   David Kirschbaum
  73.   Toad Hall
  74.   kirsch@braggvax.ARPA
  75. }
  76.  
  77.  
  78. CONST
  79.  
  80.   NRLINES = 380;
  81.   CHLIN   = 80;
  82.   PrgNam = 'UpConv v1.4';
  83.   ReservedWords : ARRAY[1..NRLINES] OF STRING[CHLIN] = (
  84.  
  85. { These words are NOT in any special order. They are alphabetized just to look
  86. neat. Not all of the words below are "reserved", some are standard functions or
  87. procedures. The words in UPPER are reserved words. }
  88.  
  89. ' Abs ABSOLUTE Addr AND Append Arc ArcTan ARRAY Assign AssignCrt Aux AuxIn ',
  90. ' AuxInPtr AuxOutPtr Bar Bar3D BEGIN BlockRead BlockWrite Boolean BufLen Byte ',
  91. ' CASE Chain Char ChDir Chr Circle ClearDevice ClearViewPort Close CloseGraph ',
  92. ' ClrEol ClrScr Con Concat ConIn ConInPtr ConOut ConOutPtr CONST ConstPtr ',
  93. ' CONSTRUCTOR ',
  94. ' Copy Cos CrtExit CrtInit CSeg Dec Delay Delete DelLine DESTRUCTOR ',
  95. ' DetectGraph DiskFree ',
  96. ' DiskSize Dispose DIV DO DosExitCode DosVersion DOWNTO Draw DSeg Ellipse ',
  97. ' ELSE END EnvCount EnvStr Eof Eoln Erase Exec Execute Exit Exp EXTERNAL ',
  98. ' False FExpand FILE FilePos FileSize FillChar FillPoly FindFirst FindNext ',
  99. ' FloodFill Flush FOR FORWARD Frac FreeMem FSplit FUNCTION GetArcCoords ',
  100. ' GetAspectRatio GetBKcolor GetCBreak GetColor GetDate GetDir GetEnv GetFAttr ',
  101. ' GetFillSettings GetFTime GetGraphMode GetImage GetIntVec GetLineSettings ',
  102. ' GetMaxX GetMaxY GetMem GetPalette GetPixel GetTextSettings GetTime ',
  103. ' GetVerify GetViewSettings GetX GetY GOTO GotoXY GraphErrorMsg GraphMode ',
  104. ' GraphResult GraphWindow Halt HeapStr Hi HiRes HiResColor HighVideo IF ',
  105. ' ImageSize IMPLEMENTATION IN Inc InitGraph INLINE Input Insert InsLine Int ',
  106. ' Integer INTERFACE INTERRUPT Intr IOResult Kbd Keep KeyPressed LABEL ',
  107. ' Length Line LineRel LineTo LN Lo LongFilePos LongFileSize LongSeek LowVideo ',
  108. ' Lst LstOut LstOutPtr Mark MaxAvail MaxInt Mem MemAvail MemW MkDir MOD Move ',
  109. ' MoveTo MSDos New NIL NormVideo NoSound NOT OBJECT Odd OF Ofs OR Ord Output ',
  110. ' OutText ',
  111. ' OutTextXY OvrPath PACKED PackTime Palette ParamCount ParamStr Pi PieSlice ',
  112. ' Plot Port PortW Pos Pred PROCEDURE PROGRAM Ptr PutImage PutPixel Random ',
  113. ' Randomize Read ReadKey ReadLn Real RECORD Rectangle Release Rename REPEAT ',
  114. ' Reset RestoreCrtMode Rewrite RmDir Round Seek SeekEof SeekEoln Seg SET ',
  115. ' SetActivePage SetAllPalette SetAspectRatio SetBKColor SetCBreak SetColor ',
  116. ' SetFAttr SetFillPattern SetFillStyle SetFTime SetGraphMode SetIntVec ',
  117. ' SetLineStyle SetPalette SetTextBuf SetTextJustify SetTextStyle SHL SetTime ',
  118. ' SetVerify SetViewPort SetVisualPage SHR Sin SizeOf Sound SPtr Sqr Sqrt SSeg ',
  119. ' Str STRING Succ Text TextBackGround TextColor TextHeight TextMode TextWidth ',
  120. ' THEN ',
  121. ' TO Trm True Trunc Truncate TYPE unError UNIT UnpackTime UNTIL USES UpCase ',
  122. ' Usr UsrIn UsrInPtr UsrOut UsrOutPtr Val VAR WhereX WhereY WHILE Window WITH ',
  123. ' Wrap Write WriteLn XOR ',
  124.  
  125. {   Some Turbo Pascal "Constants"  }
  126. ' Black Blue Green Cyan Red Magenta Brown LightGray DarkGray LightBlue ',
  127. ' LightGreen LightCyan LightRed LightMagenta Yellow White BW40 C40 BW80 C80 ',
  128.  
  129. { You may enable the additional words below if you're using them.
  130.    Be sure to adjust the constant NRLINES above to include them,
  131.    and fix up the line ends.
  132.    (E.g., add a comma after the "C80 '" above, move the ");" down to below
  133.     your last line.)
  134. }
  135.  
  136. {   Extended Graphics (from GRAPH.P). }
  137. (*
  138. ' ColorTable Arc Circle GetPic PutPic '
  139. ' GetDotColor FillPattern FillScreen FillShape Pattern ',
  140. *)
  141.  
  142. {  Turtle stuff (Tuborg 3.0)}
  143. (*
  144. ' Back ClearScreen Forwd Heading HideTurtle Home NoWrap PenUp PenDown '
  145. ' SetHeading SetPenColor SetPosition ShowTurtle TurnLeft TurnRight',
  146. ' TurtleDelay TurtleThere TurtleWindow Wrap Xcor Ycor',
  147. *)
  148.  
  149. { There's also CP/M stuff, like BDOS .. you CP/M'ers insert that. }
  150.  
  151. '','','','','','','', {40}
  152. '','','','','','','','','','','','','','','','','','','','', {60}
  153. '','','','','','','','','','','','','','','','','','','','', {80}
  154. '','','','','','','','','','','','','','','','','','','','', {100}
  155.  
  156. '','','','','','','','','','','','','','','','','','','','', {20}
  157. '','','','','','','','','','','','','','','','','','','','', {40}
  158. '','','','','','','','','','','','','','','','','','','','', {60}
  159. '','','','','','','','','','','','','','','','','','','','', {80}
  160. '','','','','','','','','','','','','','','','','','','','', {200}
  161.  
  162. '','','','','','','','','','','','','','','','','','','','', {20}
  163. '','','','','','','','','','','','','','','','','','','','', {40}
  164. '','','','','','','','','','','','','','','','','','','','', {60}
  165. '','','','','','','','','','','','','','','','','','','','', {80}
  166. '','','','','','','','','','','','','','','','','','','','', {300}
  167.  
  168. '','','','','','','','','','','','','','','','','','','','', {20}
  169. '','','','','','','','','','','','','','','','','','','','', {40}
  170. '','','','','','','','','','','','','','','','','','','','', {60}
  171. '','','','','','','','','','','','','','','',''); {380}
  172.  
  173.  
  174.   APOS          = #39;            {This is the ' symbol.}
  175.   OPENCOMMENT   = '{';
  176.   CLOSECOMMENT  = '}';
  177.  
  178. TYPE
  179.   StrChLin  = STRING[CHLIN];
  180.   Str255    = STRING [255];
  181.  
  182. CONST
  183.    {Note: These are the only valid characters that can be used in Turbo
  184.     identifiers.}
  185.   Identifier : SET OF Char = ['A'..'Z', '0'..'9', '_'];
  186.  
  187. VAR
  188.   LinUse,                     {Last line used in ReservedWords and}
  189.                               {UCReserved}
  190.   CharPsn,
  191.   LineNum    : Integer;
  192.   SpFirst,                    {TRUE = identifiers spelled as first time}
  193.   AllUpper,                   {if TRUE, all reserved words uppercased}
  194.   Lazy,                       {That's right! (read help)}
  195.   FileOutput : Boolean;       {true if output file isn't "CON:"}
  196.   UcWord,                     {possible keyword, uppercased}
  197.   Padded     : StrChLin;      {UcWord, padded with spaces}
  198.  
  199.   ProgLine   : Str255;
  200.   RamWord    : StrChLin;
  201.   InputFile,
  202.   OutputFile : Text;
  203.   UCReserved : ARRAY[1..NRLINES] OF StrChLin;  {uppercased reserved word lines}
  204.   Regs       : Registers;     {For Idle interrupts, archeologists (3.0-users)
  205.                                should define their own "registers" recordtype.}
  206.  
  207.  
  208. FUNCTION Uc(S : Str255) : Str255;
  209. VAR i : Byte;
  210. BEGIN
  211.   FOR i := 1 TO Length(S) DO S[i] := UpCase(S[i]);
  212.   Uc := S;
  213. END;  {of Uc}
  214.  
  215.  
  216. PROCEDURE Usage;
  217.   {Give user help, terminate.
  218.    Happens on cmd line of '?', '-?', '/?', '-h', '/h'
  219.   }
  220. BEGIN
  221.   WriteLn(
  222. PrgNam,' - Convert Pascal reserved words to uppercase and');
  223.   WriteLn(
  224. 'convert Turbo Pascal predefined words to Borland style; or spell all');
  225.   WriteLn(
  226. 'identifiers as the first time they appear.');
  227.   WriteLn;
  228.   WriteLn(
  229. 'Usage:  UpConv [-|/[?|H|U|F|L]] file1[.typ] [file2.typ]');
  230.   WriteLn;
  231.   WriteLn(
  232. 'where the switches -U or /U will upcase the Borland reserved words too.');
  233.   WriteLn(
  234. 'The switches -F or /F will use first spelling for all identifiers.');
  235.   WriteLn(
  236. 'The /L switch will spell reserved words in uppercase, standard identifiers');
  237.   WriteLn(
  238. 'in Borland style and any other identifiers like the first occurrence.');
  239.   WriteLn(
  240. 'Source filename file1 will be forced to .PAS if no type is given.');
  241.   WriteLn(
  242. 'Formatted output filename file2.typ defaults to FILE1.FMT');
  243.   WriteLn(
  244. 'Use output filename of CON: or PRN: to direct formatted output');
  245.   WriteLn(
  246. 'to console or printer.');
  247.   WriteLn(
  248. 'Warning: Text inside the "(*....*)" type of comments IS processed. Usefull');
  249.   WriteLn(
  250. 'for "code comments", but take care to have an equal number of ''s in that');
  251.   WriteLn(
  252. 'type of comments.');
  253.   Halt;
  254. END;  {of Usage}
  255.  
  256.  
  257. FUNCTION Exists(Name : StrChLin) : Boolean;
  258.   {Returns TRUE if file exists}
  259. VAR  f : FILE;
  260. BEGIN
  261.   Assign(f,Name);
  262.   {$I-}  Reset(f);            {try to open it}
  263.   Exists := (IOResult = 0);   {hokay, it's there}
  264.   Close(f);   {$I+}           {neaten up after us}
  265.   IF IOResult <> 0 THEN ;     {just clear IOResult}
  266. END;  {of Exists}
  267.  
  268.  
  269. PROCEDURE Open_Files;
  270. VAR
  271.   p,sw,p1,p2 : Integer;
  272.   Ch : Char;
  273.   Dummy : STRING[2];
  274.   InName,OutName : StrChLin;
  275. BEGIN
  276.   AllUpper := False;            {assume mixed Uppercase/Turbo format}
  277.   SpFirst  := False;            {don't use first spelling}
  278.  
  279.   sw := 0;                      {assume no switch parm}
  280.   p1 := 0;                      {and no file names}
  281.   p2 := 0;
  282.   FOR p := 1 TO ParamCount DO BEGIN     {check all the cmdline parms}
  283.  
  284.     Dummy := Copy(ParamStr(p),1,1);     {get first char}
  285.     Ch := Dummy[1];
  286.     CASE Ch OF
  287.       '?' : Usage;                      {give it help, terminate}
  288.       '-',
  289.       '/' : BEGIN                       {we got a switch}
  290.               sw := p;                  {this is switch parm}
  291.               IF Length(ParamStr(sw)) < 2 THEN Ch := #0       {bad}
  292.               ELSE BEGIN
  293.                 Dummy := Copy(ParamStr(sw),2,1);   {get 2d char}
  294.                 Ch := UpCase(Dummy[1]);
  295.               END;
  296.               CASE Ch OF
  297.                 '?',
  298.                 'H'  : Usage;           {give it help, terminate}
  299.                 'U'  : AllUpper := True;
  300.                 'F'  : SpFirst  := True;
  301.                 'L'  : Lazy     := True; {LR insisted on this feature}
  302.                 ELSE WriteLn('Unknown switch: [', ParamStr(p), '].  Ignored');
  303.               END;  {case of 2d char}
  304.             END;
  305.       ELSE BEGIN  {this parm wasn't a switch, fiddle filename parm nrs}
  306.  
  307.         CASE p OF
  308.           1 : p1 := 1;         {not a switch, so must be input filename}
  309.           2 : IF sw = 1        {1 was switch..}
  310.               THEN p1 := 2     {..so this must be input filename}
  311.               ELSE p2 := 2;    {..otherwise this must be output filename}
  312.           3 : IF sw = 1        {1 was the switch, so p1 is 2 already}
  313.               THEN p2 := 3;    {so 3d parm must be output filename}
  314.         END;  {case of p}
  315.  
  316.       END;  {case of non-switch parm}
  317.     END;  {Case of 1st char}
  318.  
  319.   END;  {Parameter parsing}
  320.  
  321.   IF p1 = 0 THEN Usage;             {dummy}
  322.  
  323.   IF AllUpper AND SpFirst THEN BEGIN
  324.     WriteLn('F and U switch can''t both be used');
  325.     Usage;
  326.   END;
  327.   InName := Uc(ParamStr(p1));       {move cmdline filename into string}
  328.   p := Pos('.', InName);            {remember where the type separator is}
  329.   IF p = 0 THEN p := Length(InName) {period goes at end}
  330.   ELSE p := Pred(p);                {back up from the period}
  331.  
  332.   IF p2 <> 0 THEN BEGIN             {he provided an output filename}
  333.     OutName := Uc(ParamStr(p2));    {..so use his}
  334.     IF Pos('.', OutName) = 0           {no type}
  335.     THEN OutName := OutName + '.FMT';  {copy up to separator,
  336.                                         add type}
  337.   END
  338.   ELSE BEGIN                       {he didn't provide an output filename}
  339.     OutName := Copy(InName,1,p) + '.FMT';
  340.   END;
  341.  
  342.   IF p = Length(InName)            {input filename didn't have a type...}
  343.   THEN InName := InName + '.PAS';  {.. so add on the .PAS default ending}
  344.  
  345.   IF NOT Exists(InName) THEN BEGIN
  346.     WriteLn(InName, ' not found.');
  347.     Halt;
  348.   END;
  349.  
  350.   IF OutName = InName THEN BEGIN      {can't have same name, dummy!}
  351.     WriteLn('Cannot output ', InName, ' to ', OutName);
  352.     Halt;
  353.   END;
  354.  
  355.   WriteLn('Converting ', InName, ' => ', OutName);
  356.  
  357.   FileOutput := (OutName <> 'CON:');    {set global flag}
  358.   IF FileOutput THEN BEGIN              {check for overwrite}
  359.     IF Exists(OutName) THEN BEGIN       {it exists}
  360.       Write(OutName, ' exists.  Overwrite?  [Y/N]: ');
  361.       REPEAT
  362.         Intr($28,Regs); {Idle Interrupt}
  363.       UNTIL KeyPressed;
  364.       Ch := UpCase(ReadKey);  {get his response}
  365.       IF Ch <> 'Y' THEN Halt;           {user abort}
  366.       WriteLn;
  367.     END;
  368.   END;
  369.  
  370.   Assign(InputFile,InName);
  371.   Reset(InputFile);
  372.  
  373.   Assign (OutputFile, OutName);
  374.   Rewrite (OutputFile);
  375. END;  {of Open_Files}
  376.  
  377.  
  378. PROCEDURE Uc_The_Array;
  379. {Create a new array of uppercased lines of reserved words}
  380. BEGIN
  381.   LinUse := 1;         {At least one line of reserved words}
  382.   WHILE (ReservedWords[LinUse]<>'') AND (LinUse<NRLINES) DO
  383.     BEGIN
  384.       UCReserved[LinUse] := Uc(ReservedWords[LinUse]);
  385.       LinUse := Succ(LinUse);
  386.     END;
  387.   IF LinUse<>NRLINES THEN LinUse := Pred(LinUse);
  388.   END;  {of Uc_The_Array}
  389.  
  390. PROCEDURE Reset_Array;
  391. {Reset both arrays}
  392. VAR i : Integer;
  393. BEGIN
  394.   FOR i := 1 TO NRLINES DO
  395.     BEGIN
  396.       UCReserved[i] := '';
  397.       ReservedWords[i] := '';
  398.     END; {FOR}
  399.   LinUse := 1;
  400.   END;  {of Reset_Array}
  401.  
  402. PROCEDURE ErrorHalt(S:STRING);
  403. BEGIN
  404.   WriteLn;
  405.   WriteLn(S);
  406.   Close(OutputFile);
  407.   Halt;
  408. END;
  409.  
  410. PROCEDURE Test_For_Reserved_Words;
  411. {
  412.  Test if the current word (RamWord) is in the reserved words list.
  413.  If so, write its equivalent (uppercased or Turbo Pascal format or first
  414.  used form) out to our output file.
  415.  Else just write it as it is and put it in the list if "first used form"
  416.  is active.
  417. }
  418. VAR
  419.   i,p : Integer;
  420.   Tmp : Str255;
  421. BEGIN
  422.   Padded := ' ' + Uc(RamWord) + ' ';    {bracket with spaces}
  423.  
  424.   FOR i := 1 TO LinUse DO BEGIN         {check all the reserved words}
  425.     p := Pos(Padded, UCReserved[i]);    {is this word in this word line?}
  426.     IF p > 0 THEN BEGIN                 {yep}
  427.       Padded := Copy(ReservedWords[i], Succ(p), Length(RamWord) );
  428.       IF AllUpper THEN Padded := Uc(Padded);   {force to uppercase}
  429.       Write(OutputFile, Padded);
  430.       Exit;                             {don't look at any more lines}
  431.     END;
  432.   END; {For}
  433.  
  434.   IF SpFirst OR Lazy THEN BEGIN
  435.     Tmp := ReservedWords[LinUse];
  436.     IF (Tmp='') OR (Length(Tmp+RamWord)+1>CHLIN) THEN BEGIN
  437.       IF Tmp<>'' THEN BEGIN
  438.         LinUse := Succ(LinUse); {Line full}
  439.         IF LinUse>NRLINES THEN ErrorHalt('Error: Too many identifiers.');
  440.       END;
  441.       ReservedWords[LinUse] := ' '+RamWord+' ';
  442.       UCReserved[LinUse] := ' '+Uc(RamWord)+' ';
  443.     END
  444.     ELSE BEGIN
  445.       ReservedWords[LinUse] := Tmp+RamWord+' '; {Append to line}
  446.       UCReserved[LinUse] := Uc(Tmp+RamWord)+' ';
  447.     END; {else}
  448.   END;
  449.  
  450.   Write (OutputFile, RamWord);          {write the original word}
  451. END;  {of Test_For_Reserved_Words}
  452.  
  453. PROCEDURE Process_A_Word;
  454. BEGIN
  455.   RamWord := '';
  456.   WHILE (UpCase (ProgLine [CharPsn]) IN Identifier)  {it's a legal char}
  457.   AND (CharPsn <= Length (ProgLine))                 {and line isn't done}
  458.   DO BEGIN
  459.     RamWord := RamWord + ProgLine [CharPsn];         {build our RamWord}
  460.     CharPsn := Succ(CharPsn);                        {bump ProgLine pointer}
  461.   END;
  462.   Test_For_Reserved_Words;                           {check for reserved
  463.                                                       words, write out}
  464.  
  465. END;  {of Process_A_Word}
  466.  
  467.  
  468. PROCEDURE Scan_Till (SearchChar: Char);
  469. VAR Ch : Char;  {v1.2}
  470. BEGIN
  471.   REPEAT
  472.     IF CharPsn > Length (ProgLine) THEN BEGIN
  473.       WriteLn (OutputFile);           {Simply terminates current line
  474.                                        on output.}
  475.       ReadLn (InputFile, ProgLine);   {Gets the next input line.}
  476.       IF FileOutput THEN BEGIN
  477.         Write('Processing line: ', LineNum,#$0D);
  478.         LineNum := Succ(LineNum);
  479.       END;
  480.  
  481.       IF SearchChar=APOS THEN
  482.         ErrorHalt('Error: unequal number of ''s in "(*...*)" comment');
  483.       CharPsn := 1
  484.     END;
  485.     IF ProgLine <> '' THEN BEGIN
  486.       Ch := ProgLine[CharPsn];    {v1.2 remember what this char was}
  487.       Write (OutputFile, Ch);     {v1.2 write it out}
  488.       CharPsn := Succ(CharPsn);
  489.     END
  490.     ELSE Ch := #0;                {v1.2 blank line, clear Ch}
  491.   UNTIL (Ch = SearchChar)         {v1.2 the LAST char was end of
  492.                                    quoted string or comment}
  493.   OR Eof(InputFile);
  494. END;  {of Scan_Till}
  495.  
  496.  
  497. PROCEDURE Convert;
  498. VAR Ch : Char;
  499. BEGIN
  500.   LineNum := 0;
  501.   WHILE NOT Eof(InputFile) DO BEGIN
  502.     CharPsn := 1;
  503.     ReadLn (InputFile, ProgLine);
  504.     IF FileOutput THEN BEGIN
  505.       Write('Processing line: ', LineNum,#$0D);
  506.       LineNum := Succ(LineNum);
  507.     END;
  508.     IF Length (ProgLine) = 0 THEN WriteLn (OutputFile)  {blank line}
  509.     ELSE BEGIN
  510.       REPEAT
  511.         Ch := UpCase(ProgLine[CharPsn]);
  512.         IF Ch IN Identifier THEN Process_A_Word    {could be a reserved word}
  513.         ELSE BEGIN
  514.           Write (OutputFile, ProgLine [CharPsn]);  {v1.2 write out char}
  515.           CharPsn := Succ(CharPsn);
  516.           IF Ch = OPENCOMMENT
  517.           THEN Scan_Till(CLOSECOMMENT)             {v1.2 write until
  518.                                                     closing comment}
  519.           ELSE IF Ch = APOS THEN Scan_Till(APOS);  {v1.2 write until 2d '}
  520.         END;
  521.       UNTIL (CharPsn > Length (ProgLine));
  522.       WriteLn (OutputFile);                        {new line}
  523.  
  524.     END; {If}
  525.   END;  {While}
  526.   Close (InputFile);
  527.   Close(OutputFile);
  528. END;  {of Convert}
  529.  
  530. BEGIN
  531.   Open_Files;
  532.   IF NOT SpFirst THEN
  533.     Uc_The_Array  {v1.1 build an array of uppercased reserved word lines}
  534.   ELSE IF NOT Lazy THEN Reset_Array; {Spell everything like the first occ.}
  535.   Convert;
  536. END.
  537.