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. } CONST Array_Size = 177; TYPE Answer_Set = SET OF CHAR; Cursor_Size = (Full, Half, Minimum, Invisible); Global_Strg = STRING[255]; Case_Types = (Upper, Lower, AsIs); VAR IO_Template, Work_Template, Proc_Label, Mask, Temp, Temp_String, In_File_Name, Out_File_Name : 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; {*****************************************************************************} 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} 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'; 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; {Init_Array} {*****************************************************************************} PROCEDURE Set_Cursor (Size : Cursor_Size); { cursor is set according to the passed Size ... IBM-PC specific! } TYPE Reg_Pack = RECORD AX, BX, CX, DX, BP, SI, DI, ES, Flags : INTEGER; END; {of Reg_Pack} VAR Rec_Pack : Reg_Pack; BEGIN Rec_Pack.AX := $0100; {set cursor type service code ... cf A-47 of Hardware Technical Reference Manual} CASE Size OF Full : Rec_Pack.CX := $000D; Half : Rec_Pack.CX := $070C; Minimum : Rec_Pack.CX := $0B0C; Invisible: Rec_Pack.CX := $2000; END; {CASE Size OF} Intr ($10, Rec_Pack) {call video I/O ROM call} END; {*****************************************************************************} 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; {*****************************************************************************} 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 (KBD, 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 Trim_Off (VAR TempStr : Global_Strg); BEGIN WHILE POS(' ', TempStr) = 1 DO DELETE (TempStr, 1, 1); END; {*****************************************************************************} PROCEDURE User_Quits; BEGIN Set_Cursor (Minimum); CrtExit; ClrScr; HALT; END; {*****************************************************************************} PROCEDURE Evaluate_User_Choice (ConfirmationTail : Global_Strg; Reserved : BOOLEAN); BEGIN {Evaluate_User_Choice} WRITELN; WRITE (' You chose '); TextColor (8); TextBackGround (7); CASE CD_Char OF 'U' : BEGIN WRITE ('Upper-case'); IF Reserved THEN Res_Case := Upper ELSE Non_Res_Case := Upper END; 'L' : BEGIN WRITE ('Lower-case'); IF Reserved THEN Res_Case := Lower ELSE Non_Res_Case := Lower END; 'A' : BEGIN WRITE ('As-Is'); IF Reserved THEN Res_Case := AsIs ELSE Non_Res_Case := AsIs END; 'B' : BEGIN WRITE ('Borland type setting'); Borland_Convention := TRUE; END; 'Q' : User_Quits; END; LowVideo; WRITELN (' ',ConfirmationTail); WRITE (' Is this correct? '); END; {Evaluate_User_Choice} {*****************************************************************************} PROCEDURE Change_Defaults; BEGIN {Change_Defaults} WRITELN; REPEAT WRITELN; WRITELN; WRITELN (' þ PASCAL reserved words.'); WRITE (' Options are : U(pper-case, L(ower-case, A(s-Is, Q(uit'); CD_Char := Get_Char (['U','L','A','Q']); Evaluate_User_Choice ('for the RESERVED words.', TRUE); UNTIL User_Says_YES; WRITELN; REPEAT WRITELN; WRITELN; WRITELN (' þ Turbo Pascal Extensions.'); WRITE (' Options are : U(pper, L(ower, As-Is, B(o', 'rland type setting, Q(uit'); CD_Char := Get_Char (['U','L','A','B','Q']); Evaluate_User_Choice ('for the Turbo Pascal Extensions.', TRUE); UNTIL User_Says_Yes; WRITELN; REPEAT WRITELN; WRITELN; WRITELN (' þ Non-Reserved Words.'); WRITE (' Options are : U(pper-case, L(ower-case, A(s-is, Q(uit'); CD_Char := Get_Char (['U','L','A','Q']); Evaluate_User_Choice (' for the user defined identifiers.', FALSE); UNTIL User_Says_YES; END; {Change_Defaults} {*****************************************************************************} 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 := COPY (Work_Template, (Token_Locn + (LENGTH(Token[Indx]))), 1) ELSE Next := '.'; IF Token_Locn > 1 THEN BEGIN Prior := COPY (Work_Template, Token_Locn - 1, 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] := '\'; 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); 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 ',In_File_Name,'? '); IF User_Says_YES THEN User_Quits ELSE DelLine; LowVideo; 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); 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 {no active comment} BEGIN {do nothing} END ELSE {endd <> 0} BEGIN Strt := 1; Mask_String (Endd - Strt + 1) END ELSE {strt <> 0} IF Endd <> 0 THEN Mask_String (Endd - Strt + 1) ELSE Mask_String (Len - Strt + 1); END; {Fix_Comment_Strings} {*****************************************************************************} PROCEDURE Parse; VAR Slot : INTEGER; 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); FOR Slot := 1 TO LENGTH(IO_Template) DO IF Work_Template[Slot] = ' ' THEN IO_Template[Slot] := Temp_String[Slot]; Find_Token_Match; END; {*****************************************************************************} PROCEDURE Verify_Default_Settings; BEGIN GotoXY (1,3); WRITELN; TextColor (1); TextBackGround (1); WRITELN ('Output File ',Out_File_Name,'''','s default attributes are :'); LowVideo; WRITELN (' þ TurboPASCAL key/reserved words are in UPPER-case letters and'); WRITELN (' þ Other alphabetic characters are written as is.'); WRITELN; WRITE ('Would you like to change these defaults ? '); IF User_Says_YES THEN Change_Defaults ELSE BEGIN Res_Case := Upper; Non_Res_Case := Lower; END; END; {*****************************************************************************} PROCEDURE Banner; BEGIN ClrScr; TextColor (8); TextBackGround (7); WRITELN ( ' Turbo Format [1.01] - @ndyjsdecepid@ 1984 Nov 16 ' ); END; {*****************************************************************************} PROCEDURE Get_Input_Name; BEGIN {Get_Input_Name} REPEAT WRITELN; WRITE ('Name of TurboPASCAL source text file ¯ '); READLN (In_File_Name); Trim_Off (In_File_Name); Up_Strg (In_File_Name); IF LENGTH(In_File_Name) < 1 THEN User_Quits; ASSIGN (Text_File, In_File_Name); {$I-} RESET (Text_File) {$I+}; Ok := (IOResult = 0); IF NOT Ok THEN BEGIN Sound (6099); Delay (500); Sound (600); NoSound; WRITE ('Cannot find file '); NormVideo; WRITE (In_File_Name); LowVideo; END UNTIL Ok; END; {Get_Input_Name} {*****************************************************************************} PROCEDURE Get_Output_Name; BEGIN {Get_Output_Name}; REPEAT WRITELN; WRITE ('Name of pFORMAT generated file ¯ '); READLN (Out_File_Name); Trim_Off (Out_File_Name); Up_Strg (Out_File_Name); IF LENGTH (Out_File_Name) < 1 THEN User_Quits; ASSIGN (Pretty_Output, Out_File_Name); {$I-} REWRITE (Pretty_Output) {$I+}; Ok := (IOResult = 0); IF NOT Ok THEN BEGIN WRITELN; Sound (6099); Delay (500); Sound (600); NoSound; WRITE ('Unable to open file '); NormVideo; WRITE (Out_File_Name); LowVideo; END; UNTIL Ok; END; {Get_Input_Name} {*****************************************************************************} BEGIN {--------------------------------------------------------------- pFormat} Init_Array; REPEAT Window (1, 1, 80, 25); GotoXY (1,1); ClrScr; Borland_Convention := FALSE; Comment_Active := FALSE; Banner; Window (1, 2, 80, 24); ClrScr; LowVideo; WRITELN; WRITE ('þ To quit, press a lone ',CHR(17),'Ù in response to the prompts'); WRITELN (' for file names.'); WRITELN; Get_Input_Name; Get_Output_Name; Window (1, 1, 80, 24); GotoXY (1,1); Banner; Window (1, 2, 80, 24); Verify_Default_Settings; NormVideo; WRITELN; WRITELN; WRITE ('Would you like to be able to abort this run with a keypress?'); Interruptable := User_Says_YES; LowVideo; Window (1, 1, 80, 24); GotoXY (1,1); Banner; GotoXY (1,3); TextColor (16); TextBackGround (1); Proc_Label := CONCAT ('Reading ',In_File_Name,' & generating ', Out_File_Name); IF (LENGTH (Proc_Label) <= 80) THEN {centre if it fits 80-char line} WRITE (Proc_Label:((80 + LENGTH(Proc_Label)) DIV 2)) ELSE WRITE (Proc_Label); GotoXY (1,5); NormVideo; FOR Cnt := 1 TO 80 DO WRITE ('Í'); LowVideo; Window (1, 6, 80, 23); ClrScr; Set_Cursor (Invisible); WHILE NOT (EOF(Text_File)) DO BEGIN READLN (Text_File, IO_Template); Parse; WRITELN (IO_Template); WRITELN (Pretty_Output, IO_Template); END; Set_Cursor (Minimum); CLOSE (Text_File); CLOSE (Pretty_Output); ClrScr; WRITELN; WRITE ('Quit pFORMAT'); UNTIL User_Says_YES; END. {---------------------------------------------------------------pFormat}