SPACE 2/SPACE - Library 2 - Volume 1.iso/demos/26/pascal/pforma.pas

Pascal/Delphi Source File | 1986-06-19 | 29.6 KB | 1,179 lines

PROGRAM Pformat (INPUT, OUTPUT);
{
  AUTHOR:  andy j s decepida
           16 Nov 1984

  DESCRIPTION: Reads in a .PAS text file and, depending on the user's
               choice/s, generates a copy with alterations in the case of
               the contained text.
}

{
 Converted to O.S.S. Personal Pascal for the Atari 520ST by
   Jerry LaPeer of LaPeer Systems Inc.

 05/20/86 - Concentrated on implementing Alert Boxes, and Dialog Boxes
            for input.
}

CONST
  Array_Size  =  177;

  {$I GEMCONST.PAS}

TYPE
  Answer_Set  =  SET OF CHAR;

  Cursor_Size =  (Full, Half, Minimum, Invisible);

  Global_Strg =  STRING[255];

  Case_Types  =  (Upper,
                 Lower,
                 Asis);

  OptTypes =    (UCase,LCase,AsIsOpt,BoreLand);

  {$I gemtype.pas}

VAR
  Io_Template,
  Work_Template,
  Proc_Label,
  Mask,
  Temp,
  Temp_String,
  Ifname,
  Ofname : Global_Strg;

  Text_File,
  Pretty_Output : TEXT;

  Token         : ARRAY [1..Array_Size] OF STRING[20];

  Res_Case,
  Non_Res_Case  : Case_Types;

  Strt,
  Endd,
  Indx,
  Token_Locn,
  Len,
  Cnt           : INTEGER;

  Cd_Char,
  Prior,
  Next          : CHAR;

  Borland_Convention,
  Interruptable,
  Comment_Active,
  Ok            : BOOLEAN;

  Dialog : Dialog_Ptr ;
  Button,
  Ok_Btn,
  Cancel_Btn,
  Prompt_Item,
  Date_Item : INTEGER ;

  Can_Prog:   BOOLEAN;
  ResOpt:       OptTypes;
  NrsOpt:       OptTypes;
  ExtOpt:       OptTypes;
  Reply:        Str255;

{$I gemsubs}

{*****************************************************************************}

FUNCTION Io_Result : INTEGER;
EXTERNAL;

PROCEDURE Delay(I : INTEGER);

BEGIN

END;

FUNCTION KeyPressed : BOOLEAN;

BEGIN
  KeyPressed := KeyPress;
END;

{*****************************************************************************}

PROCEDURE GotoXY(Col,Row : INTEGER);

BEGIN
  WRITE(CHR($1b),'Y',CHR(Row+$1f),CHR(Col+$1f));
END;

PROCEDURE CrtExit;

BEGIN

END;

PROCEDURE ClrScr;

BEGIN
  Clear_Screen;
END;

PROCEDURE ClrEol;

BEGIN

END;

{*****************************************************************************}

PROCEDURE Sound(Slen : INTEGER);

BEGIN

END;

PROCEDURE NoSound;

BEGIN

END;

PROCEDURE TextColor (Color : INTEGER);

BEGIN

END;

PROCEDURE TextBackGround (Color : INTEGER);

BEGIN

END;

PROCEDURE Set_Cursor (Size : Cursor_Size);
  {
    cursor is set according to the passed Size ... IBM-PC specific!
  }

BEGIN

END;

{*****************************************************************************}

PROCEDURE Init_A1;

BEGIN
    Token [  1] := 'ABSOLUTE';
    Token [  2] := 'ARCTAN';
    Token [  3] := 'ASSIGN';
    Token [  4] := 'AUXINPTR';
    Token [  5] := 'AUXOUTPTR';
    Token [  6] := 'BLOCKREAD';
    Token [  7] := 'BLOCKWRITE';
    Token [  8] := 'BOOLEAN';
    Token [  9] := 'BUFLEN';
    Token [ 10] := 'CLREOL';
    Token [ 11] := 'CLRSCR';
    Token [ 12] := 'CONCAT';
    Token [ 13] := 'CONINPTR';
    Token [ 14] := 'CONOUTPTR';
    Token [ 15] := 'CONSTPTR';
    Token [ 16] := 'CRTEXIT';
    Token [ 17] := 'CRTINIT';
    Token [ 18] := 'DELETE';
    Token [ 19] := 'DELLINE';
    Token [ 20] := 'DOWNTO';
    Token [ 21] := 'EXECUTE';
    Token [ 22] := 'EXTERNAL';
    Token [ 23] := 'FILEPOS';
    Token [ 24] := 'FILESIZE';
    Token [ 25] := 'FILLCHAR';
    Token [ 26] := 'FORWARD';
    Token [ 27] := 'FREEMEM';
    Token [ 28] := 'FUNCTION';
    Token [ 29] := 'GETMEM';
    Token [ 30] := 'GOTOXY';
    Token [ 31] := 'GRAPHBACKGROUND';
    Token [ 32] := 'GRAPHCOLORMODE';
    Token [ 33] := 'GRAPHMODE';
    Token [ 34] := 'GRAPHWINDOW';
    Token [ 35] := 'HEAPSTR';
    Token [ 36] := 'HIRESCOLOR';
    Token [ 37] := 'INLINE';
    Token [ 38] := 'INSERT';
    Token [ 39] := 'INSLINE';
    Token [ 40] := 'INTEGER';
    Token [ 41] := 'IORESULT';
    Token [ 42] := 'KEYPRESSED';
    Token [ 43] := 'LENGTH';
    Token [ 44] := 'LONGFILEPOS';
    Token [ 45] := 'LONGFILESIZE';
    Token [ 46] := 'LONGSEEK';
    Token [ 47] := 'LOWVIDEO';
    Token [ 48] := 'LSTOUTPTR';
    Token [ 49] := 'MAXAVAIL';
    Token [ 50] := 'MAXINT';
    Token [ 51] := 'MEMAVAIL';
    Token [ 52] := 'NORMVIDEO';
    Token [ 53] := 'NOSOUND';
    Token [ 54] := 'OUTPUT';
    Token [ 55] := 'PACKED';
    Token [ 56] := 'PALETTE';
    Token [ 57] := 'PROCEDURE';
    Token [ 58] := 'PROGRAM';
    Token [ 59] := 'RANDOMIZE';
    Token [ 60] := 'RANDOM';
    Token [ 61] := 'READLN';
    Token [ 62] := 'RECORD';
    Token [ 63] := 'RELEASE';
    Token [ 64] := 'RENAME';
    Token [ 65] := 'REPEAT';
    Token [ 66] := 'REWRITE';
    Token [ 67] := 'SIZEOF';
    Token [ 68] := 'STRING';
    Token [ 69] := 'TEXTBACKGROUND';
    Token [ 70] := 'TEXTCOLOR';
    Token [ 71] := 'TEXTMODE';
    Token [ 72] := 'UPCASE';
    Token [ 73] := 'USRINPTR';
    Token [ 74] := 'USROUTPTR';
    Token [ 75] := 'WHEREX';
    Token [ 76] := 'WHEREY';
    Token [ 77] := 'WINDOW';
    Token [ 78] := 'WRITELN';
    Token [ 79] := 'ARRAY';
    Token [ 80] := 'BEGIN';
    Token [ 81] := 'CHAIN';
    Token [ 82] := 'CLOSE';
    Token [ 83] := 'CONST';
    Token [ 84] := 'DELAY';
    Token [ 85] := 'ERASE';
    Token [ 86] := 'FALSE';
    Token [ 87] := 'FLUSH';
    Token [ 88] := 'HIRES';
END;

PROCEDURE Init_A2;

BEGIN
    Token [ 89] := 'INPUT';
    Token [ 90] := 'LABEL';
    Token [ 91] := 'MSDOS';
    Token [ 92] := 'PORTW';
    Token [ 93] := 'RESET';
    Token [ 94] := 'ROUND';
    Token [ 95] := 'SOUND';
    Token [ 96] := 'TRUNC';
    Token [ 97] := 'UNTIL';
    Token [ 98] := 'WHILE';
    Token [ 99] := 'WRITE';
    Token [100] := 'ADDR';
    Token [101] := 'BYTE';
    Token [102] := 'CASE';
    Token [103] := 'CHAR';
    Token [104] := 'COPY';
    Token [105] := 'CSEG';
    Token [106] := 'DRAW';
    Token [107] := 'DSEG';
    Token [108] := 'ELSE';
    Token [109] := 'EOLN';
    Token [110] := 'FILE';
    Token [111] := 'FRAC';
    Token [112] := 'GOTO';
    Token [113] := 'HALT';
    Token [114] := 'INTR';
    Token [115] := 'MARK';
    Token [116] := 'MEMW';
    Token [117] := 'MOVE';
    Token [118] := 'PLOT';
    Token [119] := 'PORT';
    Token [120] := 'PRED';
    Token [121] := 'READ';
    Token [122] := 'REAL';
    Token [123] := 'SEEK';
    Token [124] := 'SQRT';
    Token [125] := 'SSEG';
    Token [126] := 'SUCC';
    Token [127] := 'SWAP';
    Token [128] := 'TEXT';
    Token [129] := 'THEN';
    Token [130] := 'TRUE';
    Token [131] := 'TYPE';
    Token [132] := 'WITH';
    Token [133] := 'AND';
    Token [134] := 'AUX';
    Token [135] := 'CHR';
    Token [136] := 'CON';
    Token [137] := 'COS';
    Token [138] := 'DIV';
    Token [139] := 'END';
    Token [140] := 'EOF';
    Token [141] := 'EXP';
    Token [142] := 'FOR';
    Token [143] := 'INT';
    Token [144] := 'KBD';
    Token [145] := 'LST';
    Token [146] := 'MEM';
    Token [147] := 'MOD';
    Token [148] := 'NEW';
    Token [149] := 'NIL';
    Token [150] := 'NOT';
    Token [151] := 'ODD';
    Token [152] := 'OFS';
    Token [153] := 'ORD';
    Token [154] := 'POS';
    Token [155] := 'PTR';
    Token [156] := 'SEG';
    Token [157] := 'SET';
    Token [158] := 'SHL';
    Token [159] := 'SHR';
    Token [160] := 'SIN';
    Token [161] := 'SQR';
    Token [162] := 'STR';
    Token [163] := 'TRM';
    Token [164] := 'USR';
    Token [165] := 'VAL';
    Token [166] := 'VAR';
    Token [167] := 'XOR';
    Token [168] := 'DO';
    Token [169] := 'HI';
    Token [170] := 'IF';
    Token [171] := 'IN';
    Token [172] := 'LN';
    Token [173] := 'LO';
    Token [174] := 'OF';
    Token [175] := 'OR';
    Token [176] := 'PI';
    Token [177] := 'TO';

END;

PROCEDURE Init_A3;

BEGIN

END;

PROCEDURE Init_Array;
  {
    initialize the reserved word array

  Warning: because the primitive parsing method employed here centred
  crucially on this array it is NOT recommended that you alter the
  contents and sequence of the entries.  My apologies non MS-DOS users
  for not including the reserved words that their TurboPascal editions do
  support.  Should you, as say as CP/M Turbo programmer, wish to alter
  this table keep in mind two things:


  ~ Do_Turbo_Extension uses the index (INDX) corresponding to the table
    entry of a found reserved word to assign the Borland type setting style
    to the output substring ... ergo, keep the new array indices in synch
    with the CASE selectors in Do_Turbo_Extension.

  ~ Since pFORMAT sequentially steps through this array to find a corresponding
    pattern occurrences in the text line currently being processed, it
    becomes important to keep the shorter reserved words that are embedded in
    other, longer reserved words as substrings towards the bottom of the
    array!
}
BEGIN {Init_Array}
  Init_A1;
  Init_A2;
END;  {Init_Array}

{*****************************************************************************}

FUNCTION Is_Special_Char (Ch : CHAR) : BOOLEAN;
  {
    TRUE if Ch is a special char
  }

BEGIN
  Is_Special_Char := (ORD(Ch) IN [32, 39..47, 58..62, 91, 93, 123, 125])
END;

{*****************************************************************************}

FUNCTION Lo_Case (Ch : CHAR) : CHAR;
  {
    returns lower case of an alpha char
  }

BEGIN
  IF (Ch IN ['A'..'Z'])
    THEN Ch := CHR (ORD(Ch) - ORD('A') + ORD('a'));
  Lo_Case := Ch
END;

{*****************************************************************************}

FUNCTION UpCase(C : CHAR) : CHAR;

BEGIN

  IF C IN ['a'..'z']
    THEN UpCase := CHR(ORD(C) - (ORD('a') - ORD('A')))
    ELSE UpCase := C;

END;

PROCEDURE Up_Strg (VAR Strg : Global_Strg);

VAR
  Slot : INTEGER;

BEGIN
  IF (LENGTH(Strg) > 0)
    THEN FOR Slot := 1 TO LENGTH(Strg) DO
      Strg[Slot] := UpCase(Strg[Slot])
END;

{*****************************************************************************}

PROCEDURE Lo_Strg (VAR Strg : Global_Strg);

VAR
  Slot : INTEGER;

BEGIN
  IF (LENGTH(Strg) > 0)
    THEN FOR Slot := 1 TO LENGTH(Strg) DO
      Strg[Slot] := Lo_Case(Strg[Slot])
END;

{*****************************************************************************}

FUNCTION Get_Char (Legal_Commands : Answer_Set) : CHAR;
  {
    waits for a CHAR input belonging in Legal_Commands
  }

CONST
  Bks = 8;

VAR
  Ch_In : CHAR;

BEGIN
  WRITE ('[ ]');
  WRITE (CHR(Bks), CHR(Bks), ' ',CHR(Bks));
  REPEAT
    Set_Cursor (Full);
    READ (Ch_In);
    Ch_In := UpCase (Ch_In);
    IF NOT (Ch_In IN Legal_Commands)
      THEN BEGIN
        Sound (8900);
        Delay (10);
        NoSound;
        Sound (90);
        Delay (30);
        NoSound;
      END;
  UNTIL (Ch_In IN Legal_Commands);
  Set_Cursor (Minimum);
  Get_Char := Ch_In;
END;

{*****************************************************************************}

FUNCTION User_Says_Yes : BOOLEAN;
  {
    waits for a y/Y or n/N CHAR input
  }

VAR
  Reply : CHAR;

BEGIN
  WRITE (' [y/n] ~ ');
  User_Says_Yes := (Get_Char(['Y','N']) = 'Y')
END;

{*****************************************************************************}

  PROCEDURE User_Quits;

  BEGIN
    Set_Cursor (Minimum);
    CrtExit;
    ClrScr;
    HALT;
  END;

{*****************************************************************************}

  FUNCTION Is_A_Token : BOOLEAN;
  {
    returns TRUE if the pattern found is properly delimited
  }
  BEGIN {Is_A_Token}
    IF (Token_Locn + LENGTH(Token[Indx])) < Len THEN
      Next := Work_Template[Token_Locn + (LENGTH(Token[Indx]))]
    ELSE
      Next := '.';

    IF Token_Locn > 1 THEN
      BEGIN
        Prior := Work_Template[Token_Locn - 1];
        Is_A_Token := ((Is_Special_Char(Prior)) AND (Is_Special_Char(Next)));
      END
    ELSE
      IF Token_Locn = 1 THEN
        Is_A_Token := (Is_Special_Char (Next));
  END; {Is_A_Token}

{*****************************************************************************}

PROCEDURE Mask_Out (Keyword : Global_Strg);
  {
    mask out a pattern match ... to enable multi-occurrences
  }
VAR
  Slot : INTEGER;

BEGIN {Mask_Out}
  DELETE (Work_Template, Token_Locn, LENGTH(Token[Indx]));
  Mask := Keyword;
  FOR Slot := 1 TO LENGTH(Keyword) DO
    Mask[Slot] := '\';
  IF Work_Template = ''
    THEN Work_Template := Mask
    ELSE IF LENGTH(Work_Template) < Token_Locn
           THEN Work_Template := CONCAT(Work_Template, Mask)
           ELSE INSERT (Mask, Work_Template, Token_Locn);
END;  {Mask_Out}

{*****************************************************************************}

 PROCEDURE Do_Turbo_Extension (VAR Extension : Global_Strg);

 BEGIN {Do_Turbo_Extension}
   CASE Indx OF
      1 : Extension := 'Absolute';
      3 : Extension := 'Assign';
      4 : Extension := 'AuxInPtr';
      5 : Extension := 'AuxOutPtr';
      9 : Extension := 'BufLen';
     10 : Extension := 'ClrEol';
     11 : Extension := 'ClrScr';
     13 : Extension := 'ConInPtr';
     14 : Extension := 'ConOutPtr';
     15 : Extension := 'ConstPtr';
     16 : Extension := 'CrtExit';
     17 : Extension := 'CrtInit';
     19 : Extension := 'DelLine';
     21 : Extension := 'Execute';
     23 : Extension := 'FilePos';
     24 : Extension := 'FileSize';
     25 : Extension := 'FillChar';
     27 : Extension := 'FreeMem';
     29 : Extension := 'GetMem';
     30 : Extension := 'GotoXY';
     31 : Extension := 'GraphBackGround';
     32 : Extension := 'GraphColorMode';
     33 : Extension := 'GraphMode';
     34 : Extension := 'GraphWindow';
     35 : Extension := 'HeapStr';
     36 : Extension := 'HiResColor';
     37 : Extension := 'InLine';
     39 : Extension := 'InsLine';
     41 : Extension := 'IOResult';
     42 : Extension := 'KeyPressed';
     44 : Extension := 'LongFilePos';
     45 : Extension := 'LongFileSize';
     46 : Extension := 'LongSeek';
     47 : Extension := 'LowVideo';
     48 : Extension := 'LstOutPtr';
     49 : Extension := 'MaxAvail';
     52 : Extension := 'NormVideo';
     53 : Extension := 'NoSound';
     56 : Extension := 'Palette';
     59 : Extension := 'Randomize';
     60 : Extension := 'Random';
     64 : Extension := 'Rename';
     69 : Extension := 'TextBackGround';
     70 : Extension := 'TextColor';
     71 : Extension := 'TextMode';
     72 : Extension := 'UpCase';
     73 : Extension := 'UsrInPtr';
     74 : Extension := 'UsrOutPtr';
     75 : Extension := 'WhereX';
     76 : Extension := 'WhereY';
     77 : Extension := 'Window';
     81 : Extension := 'Chain';
     84 : Extension := 'Delay';
     85 : Extension := 'Erase';
     87 : Extension := 'Flush';
     88 : Extension := 'HiRes';
     91 : Extension := 'MSDos';
     92 : Extension := 'PortW';
     95 : Extension := 'Sound';
    100 : Extension := 'Addr';
    101 : Extension := 'Byte';
    105 : Extension := 'CSeg';
    106 : Extension := 'Draw';
    107 : Extension := 'DSeg';
    111 : Extension := 'Frac';
    114 : Extension := 'Intr';
    116 : Extension := 'MemW';
    117 : Extension := 'Move';
    118 : Extension := 'Plot';
    119 : Extension := 'Port';
    123 : Extension := 'Seek';
    124 : Extension := 'Sqrt';
    125 : Extension := 'SSeg';
    127 : Extension := 'Swap';
    134 : Extension := 'Aux';
    136 : Extension := 'Con';
    144 : Extension := 'Kbd';
    145 : Extension := 'Lst';
    146 : Extension := 'Mem';
    152 : Extension := 'Ofs';
    155 : Extension := 'Ptr';
    156 : Extension := 'Seg';
    158 : Extension := 'ShL';
    159 : Extension := 'ShR';
    163 : Extension := 'Trm';
    164 : Extension := 'Usr';
    167 : Extension := 'XOr';
    169 : Extension := 'Hi';
    173 : Extension := 'Lo';
    176 : Extension := 'Pi';
   END; {CASE Indx OF}
 END;  {Do_Turbo_Extension}

{*****************************************************************************}

PROCEDURE Do_Reserved_Word;

BEGIN
  Temp := Token [Indx];
  DELETE (Io_Template, Token_Locn, LENGTH(Token[Indx]));
  IF Res_Case = Lower
    THEN Lo_Strg (Temp);
  IF Borland_Convention
    THEN Do_Turbo_Extension (Temp);
  IF Io_Template = ''
    THEN Io_Template := Temp
    ELSE IF LENGTH(Io_Template) < Token_Locn
           THEN Io_Template := CONCAT(Io_Template, Temp)
           ELSE INSERT (Temp, Io_Template, Token_Locn);
END;

{*****************************************************************************}

   PROCEDURE Tablesearch;

   BEGIN
     Indx := 1;
     REPEAT
       Token_Locn := POS (Token[Indx], Work_Template);
       IF (Token_Locn <> 0) AND Is_A_Token THEN
         BEGIN                    {pattern match is reserved word}
           IF Res_Case <> Asis THEN
             Do_Reserved_Word;
           Mask_Out (Token[Indx]);
           Tablesearch            {recurse!!!}
         END;
       IF Token_Locn <> 0 THEN    {pattern match NOT reserved}
         Mask_Out (Token[Indx]);
       IF Token_Locn = 0 THEN     {no pattern match}
         Indx := Indx + 1;
     UNTIL ( (Indx > Array_Size) AND (Token_Locn = 0) );
   END;

{*****************************************************************************}

   PROCEDURE Find_Token_Match;

   BEGIN {Find_Token_Match}
     REPEAT      {exhaust all keyword occurrences in a line of text}
       Tablesearch;
       IF Interruptable THEN
         IF KeyPressed THEN
           BEGIN
             TextColor (24); TextBackGround (1);
             WRITELN;
             WRITE ('Abort pFORMAT of ',Ifname,'? ');
             IF User_Says_Yes THEN User_Quits
           END;
     UNTIL Token_Locn = 0;
   END;  {Find_Token_Match}

{*****************************************************************************}

PROCEDURE Fix_Comment_Strings;
  {
    mask out comments & strings so as-is chars can be restored from
    Temp_String onto IO_Template
  }

  PROCEDURE Mask_String (Len_Comment : INTEGER);

  VAR
    Slot : INTEGER;

  BEGIN
    Temp_String := COPY (Work_Template, Strt, Len_Comment);
    FOR Slot := 1 TO LENGTH(Temp_String) DO
      Temp_String[Slot] := ' ';
    DELETE (Work_Template, Strt, Len_Comment);
    IF Work_Template = ''
      THEN Work_Template := Temp_String
      ELSE IF LENGTH(Work_Template) < STRt
             THEN Work_Template := CONCAT(Work_Template,Temp_String)
             ELSE INSERT (Temp_String, Work_Template, Strt);
  END;

BEGIN {Fix_Comment_Strings} {DO Strings}

  REPEAT
    Strt := POS('''', Work_Template);
    IF Strt <> 0
      THEN Work_Template[Strt] := ' ';
    Endd := POS ('''', Work_Template);
    IF Endd <> 0
      THEN Work_Template[Endd] := ' ';
    IF ((Endd <> 0) AND (Strt <> 0))
      THEN Mask_String (Endd - Strt + 1);
  UNTIL ((Endd = 0) OR (Strt = 0));

  Strt := POS('{', Work_Template);
  IF Strt = 0
    THEN {check again for alternative delimiter}
         Strt := POS ('(*', Work_Template);

  Endd := POS('}', Work_Template);
  IF Endd = 0
    THEN {check again for alternate delimiter}
         Endd := POS('*)', Work_Template);

  IF Strt <> 0
    THEN Comment_Active := TRUE;

  IF Endd <> 0
    THEN Comment_Active := FALSE;

  IF Strt = 0
    THEN IF Endd = 0
           THEN IF Comment_Active
                  THEN BEGIN
                    Strt := 1;
                    Mask_String (Len - Strt + 1)
                  END
                  ELSE BEGIN {no active comment}
                    {do nothing}
                  END
           ELSE BEGIN {endd <> 0}
             Strt := 1;
             Mask_String (Endd - Strt + 1)
           END
    ELSE IF Endd <> 0
           THEN Mask_String (Endd - Strt + 1)
           ELSE Mask_String (Len - Strt + 1);

END; {Fix_Comment_Strings}

{*****************************************************************************}

PROCEDURE Parse;

VAR
  Slot : INTEGER;
  Makeup : BOOLEAN;

BEGIN

  Work_Template := Io_Template;
  Len := LENGTH (Io_Template);

  Fix_Comment_Strings;

  Up_Strg (Work_Template);

  Temp_String := Io_Template;

  IF Non_Res_Case = Upper
    THEN Up_Strg (Io_Template)
    ELSE IF Non_Res_Case = Lower
           THEN Lo_Strg (Io_Template);

  Makeup := TRUE;

  FOR Slot := 1 TO LENGTH(Io_Template) DO
    IF Work_Template[Slot] = ' '
      THEN Io_Template[Slot] := Temp_String[Slot];

  Find_Token_Match;

  Makeup := TRUE;

  FOR Slot := 1 TO LENGTH(Io_Template) DO
    IF Work_Template[Slot] = ' '
      THEN BEGIN
        Io_Template[Slot] := Temp_String[Slot];
        Makeup := TRUE;
      END
      ELSE BEGIN
        IF ((Makeup) AND (Io_Template[Slot] <> ' '))
          THEN BEGIN
            Io_Template[Slot] := UpCase(Io_Template[Slot]);
            Makeup := FALSE;
          END;
        IF Io_Template[Slot] IN ['_',' ','=',':',
                                 '(',')','[',']',
                                 '<','>',';','+',
                                 '-','/','*','^',
                                 ',','@','$','.']
          THEN Makeup := TRUE;
      END;
END;

PROCEDURE Get_Options;

VAR
  SelId:        INTEGER;
  Alert_Prompt: Str255;
  UcBtn,LcBtn,AiBtn,BlBtn : INTEGER;

  FUNCTION GetOption(Title : Str255;
                     DefOpt : OptTypes) : OptTypes;

  VAR
    I:          INTEGER;

  BEGIN

    Dialog := New_Dialog( 8, 0, 0, 40, 9 ) ;

    I := (38  DIV 2) - (LENGTH(Title) DIV 2);

    IF I < 1 THEN I := 0;

    Prompt_Item := Add_Ditem( Dialog, G_String, None, I+2, 1, 35, 1, 0, 0 ) ;

    Set_Dtext( Dialog, Prompt_Item, Title,
                       System_Font, Te_Left ) ;

    UcBtn := Add_Ditem( Dialog, G_Button, Selectable|exit_Btn,
                                2, 3, 9, 2, 2, $0000 ) ;

    Set_Dtext( Dialog, UcBtn, 'UPPERCASE', System_Font, Te_Center ) ;

    LcBtn := Add_Ditem( Dialog, G_Button, Selectable|exit_Btn,
                                13, 3, 9, 2, 2, $0000 ) ;

    Set_Dtext( Dialog, LcBtn, 'lowercase', System_Font, Te_Center ) ;

    AiBtn := Add_Ditem( Dialog, G_Button, Selectable|exit_Btn,
                                24, 3, 4, 2, 2, $1180 ) ;

    Set_Dtext( Dialog, AiBtn, 'AsIs', System_Font, Te_Center ) ;

    BlBtn := Add_Ditem( Dialog, G_Button, Selectable|exit_Btn,
                                30, 3, 8, 2, 2, $1180 ) ;

    Set_Dtext( Dialog, BlBtn, 'BoreLand', System_Font, Te_Center ) ;

    Ok_Btn := Add_Ditem( Dialog, G_Button, Selectable|Default|exit_Btn,
                                 9, 6, 8, 2, 2, $1180 ) ;

    Set_Dtext( Dialog, Ok_Btn, 'OK', System_Font, Te_Center ) ;

    Cancel_Btn := Add_Ditem( Dialog, G_Button, Selectable|exit_Btn,
                                     23, 6, 8, 2, 2, $1180 ) ;

    Set_Dtext( Dialog, Cancel_Btn, 'Cancel', System_Font, Te_Center ) ;

    Center_Dialog( Dialog ) ;

    Button := Do_Dialog( Dialog, 0) ;

    End_Dialog(Dialog);

    Delete_Dialog(Dialog);

    IF Button = UcBtn        THEN GetOption := UCase
      ELSE IF Button = LcBtn THEN GetOption := LCase
      ELSE IF Button = AiBtn THEN GetOption := AsIsOpt
      ELSE IF Button = BlBtn THEN GetOption := BoreLand
      ELSE GetOption := DefOpt;

    Clear_Screen;

  END;

BEGIN

  REPEAT

    Alert_Prompt := '[0][Defaults Reserved     ';

    CASE ResOpt OF
      UCase    : Alert_Prompt := ConCat(Alert_Prompt,'UPPERCASE|');
      LCase    : Alert_Prompt := ConCat(Alert_Prompt,'lowercase|');
      AsIsOpt  : Alert_Prompt := ConCat(Alert_Prompt,'As Is|');
      BoreLand : Alert_Prompt := ConCat(Alert_Prompt,'BoreLand|');
    END;

    Alert_Prompt := ConCat(Alert_Prompt,'         Non-Reserved ');

    CASE NrsOpt OF
      UCase    : Alert_Prompt := ConCat(Alert_Prompt,'UPPERCASE|');
      LCase    : Alert_Prompt := ConCat(Alert_Prompt,'lowercase|');
      AsIsOpt  : Alert_Prompt := ConCat(Alert_Prompt,'As Is|');
      BoreLand : Alert_Prompt := ConCat(Alert_Prompt,'BoreLand|');
    END;

    Alert_Prompt := ConCat(Alert_Prompt,'         Extentions   ');

    CASE ExtOpt OF
      UCase    : Alert_Prompt := ConCat(Alert_Prompt,'UPPERCASE]');
      LCase    : Alert_Prompt := ConCat(Alert_Prompt,'lowercase]');
      AsIsOpt  : Alert_Prompt := ConCat(Alert_Prompt,'As Is]');
      BoreLand : Alert_Prompt := ConCat(Alert_Prompt,'BoreLand]');
    END;

    Alert_Prompt := ConCat(Alert_Prompt,'[ Change | Ok | Cancel ]');

    SelId := Do_Alert(Alert_Prompt,0);

    Clear_Screen;

    IF SelId = 1
      THEN BEGIN
        Alert_Prompt := '';
        Alert_Prompt := ConCat('[0]',
  '[           Select One           ]',
  '[ Res | Non Res | Ext ]');
        SelId := Do_Alert(Alert_Prompt,0);
        Clear_Screen;
        CASE SelId OF
          1 : ResOpt := GetOption('Reserved',ResOpt);
          2 : NrsOpt := GetOption('Non-Reserved',NrsOpt);
          3 : ExtOpt := GetOPtion('Extension',ExtOpt);
        END;
        SelId := 0;
      END;

  UNTIL SeLid IN [2..3];

END;

FUNCTION Get_Ofname(    Prompt : Str255;
                    VAR Path : Path_Name) : BOOLEAN;

VAR
  Template:     Str255;
  Validation:   Str255;
  I:            INTEGER;
  I1:           INTEGER;

  Dialog : Dialog_Ptr ;
  Button,
  Ok_Btn,
  Cancel_Btn,
  Prompt_Item,
  Fname_Item : INTEGER ;

BEGIN

  IF LENGTH(Prompt) > LENGTH(Path)
    THEN I := LENGTH(Prompt) + 12
    ELSE I := LENGTH(Path) + 12;

  IF I < 45 THEN I := 45;

  IF I > 75 THEN I := 75;

  Dialog := New_Dialog( 4, 0, 0, I+4, 8 ) ;

  I1 := (I DIV 2) - (LENGTH(Prompt) DIV 2);

  Prompt_Item := Add_Ditem( Dialog, G_String, None,
                            I1+2, 1, I, 0, 0, 0 ) ;

  Set_Dtext( Dialog, Prompt_Item, Prompt,
                     System_Font, Te_Center ) ;

  Fname_Item := Add_Ditem( Dialog, G_FText, None, 2, 3, I, 1, 0, $1180 );

  Template := '';

  FOR I1 := 1 TO I DO Template := ConCat(Template,'_');

  Validation := '';

  FOR I1 := 1 TO I DO Validation := ConCat(Validation,'p');

  Set_Dedit( Dialog, Fname_Item, Template, Validation, Path,
                     System_Font, Te_Left ) ;

  I1 := (I DIV 2) - 11;

  Ok_Btn := Add_Ditem( Dialog, G_Button, Selectable|exit_Btn|default,
                               I1+2, 5, 8, 2, 2, $1180 ) ;

  Set_Dtext( Dialog, Ok_Btn, 'OK', System_Font, Te_Center ) ;

  Cancel_Btn := Add_Ditem( Dialog, G_Button, Selectable|exit_Btn,
                                   I1+16, 5, 8, 2, 2, $1180 ) ;

  Set_Dtext( Dialog, Cancel_Btn, 'Cancel', System_Font, Te_Center ) ;

  Center_Dialog( Dialog ) ;

  Button := Do_Dialog( Dialog, Date_Item ) ;

  Get_Dedit( Dialog, Date_Item, Template);

  End_Dialog(Dialog);

  Delete_Dialog(Dialog);

  Path := Template;

  IF Button = Cancel_Btn
    THEN Get_Ofname := TRUE
    ELSE Get_Ofname := FALSE;

  Clear_Screen;

END;

PROCEDURE Get_Ifname;

VAR
  Path:         Path_Name;

BEGIN

  Path := 'd:*.*';

  IF Get_In_File(Path, Ifname)
    THEN BEGIN
      Clear_Screen;
      Ofname := Ifname;
      Can_Prog := Get_Ofname('Pascal Formated File Name',
                             Ofname);
    END
    ELSE BEGIN
      Clear_Screen;
      Can_Prog := TRUE;
    END;

END;

{*****************************************************************************}

BEGIN {--------------------------------------------------------------- pFormat}

  IF Init_Gem >= 0
    THEN BEGIN

      Clear_Screen;

      ResOpt := UCase;
      NrsOpt := LCase;
      ExtOpt := BoreLand;

      Can_Prog := FALSE;

      Init_Array;

      Reply := ConCat('[0]',
                      '[  Abort with a Keypress?   ]',
                      '[ Yes | No | Cancel]');

      CASE Do_Alert(Reply,0) OF
        1 : Interruptable := TRUE;
        2 : Interruptable := FALSE;
        3 : Can_Prog := TRUE;
      END;

      Clear_Screen;

      WHILE NOT Can_Prog DO BEGIN

        Clear_Screen;

        GotoXY (1,1);

        Get_Ifname;

        IF NOT Can_Prog
          THEN BEGIN

            Get_Options;

            IF NOT Can_Prog
              THEN BEGIN
                CASE ResOpt OF
                  UCase   : Res_Case := Upper;
                  LCase   : Res_Case := Lower;
                  AsIsOpt : Res_Case := AsIs;
                END;

                CASE NrsOpt OF
                  UCase   : Non_Res_Case := Upper;
                  LCase   : Non_Res_Case := Lower;
                  AsIsOpt : Non_Res_Case := AsIs;
                END;

                CASE ExtOpt OF
                  UCase   : Borland_Convention := FALSE;
                  LCase   : Borland_Convention := FALSE;
                  AsIsOpt : Borland_Convention := FALSE;
                  BoreLand: Borland_Convention := TRUE;
                END;

                Clear_Screen;

                Hide_Mouse;

                Comment_Active := FALSE;

                RESET(Text_File,Ifname);
                REWRITE(Pretty_Output,Ofname);

                WHILE (NOT (EOF(Text_File))) AND
                      (NOT Can_Prog) DO BEGIN
                  READLN  (Text_File, Io_Template);
                  Parse;
                  WRITELN (Io_Template);
                  WRITELN (Pretty_Output, Io_Template);
                END;

                CLOSE (Text_File);
                CLOSE (Pretty_Output);

                Show_Mouse;

              END;
          END;

        IF NOT Can_Prog
          THEN CASE Do_Alert('[0][Format another program?][ Yes | No ]',0) OF
                 1 : Can_Prog := FALSE;
                 2 : Can_Prog := TRUE;
               END;

        Clear_Screen;

      END;

      Exit_Gem ;

    END ;

END.  {---------------------------------------------------------------pFormat}
;
     35 : Extension := 'HeapStr';
     36 : Extension := 'HiRes