LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!) WAP /// SIG PUBLIC DOMAIN LIBRARY PDS NAME: David Craig Disk #2 DISK ID#: 3PCL-14 BOOTABLE?: Nonbootable DESCRIPTION: Disks 3PCL-13, 14 and 15 are some of the nuggets we got from a donation by Joe Dobrowolski (of Apple Users Group Internat ;t1 -READ.ME.FIRST,(III.PCL.14u' -PPRINT.0.TEXT 4  -PPRINT.1.TEXT&=x00-PPRINT.2.TEXTb%H22-PPRINT.3.TEXT66-PPRINT.4.TEXT=x56-PPRINT.5.TEXT >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@Lional). We call them "David Craig Disks 1,2 and 3" since the material on these disks were all placed into the PD by ///er David Craig. All require knowledge of Pascal to operate properly. On Side One: -: PPRINT : Pascal source code pretty printer util [] [] [] [] Author : David T. Craig ( 736 Edgewater, Wichita KS 67230 ) [] [] Date : 1987 [] [] Language : A R E T T Y P R I N T E R [] [] ------------------------------------------------------------------ [] [] [] [] Version - 1.04 { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] ------------------------------------------------------------------ [] [] P A S C A L P  !"#$%O^ŰO^Ű parsing any Pascal program. -: program. -: ity that supports -: hilighting of Pascal's reserved words. Allows the user the -: ability to define words which are also hilighted. -: -: ON SIDE TWO: -: UTS : Pascal token search unit which is used by PPRINT. Useful for -: pple /// Pascal 1.1 [] [] Computer : Apple /// [] [] [] [] PURPOSE [] [] [] [] Output text files to either a printer or another file in a [] [] "pretty" manner; i.e., --> } {^FF} PROGRAM PrettyPrint; { And now here's ... } { ------------------------------------------------------------------------ } { Compile-time conditional variables --- set as appropriate } {$SETC fHasClock := TRUE } { Clock installed } **************************************** [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } { This is PrettyPrint's New Page imbedded comment command - [] ****************************************************************** [] [] * THIS PROGRAM IS PLACED INTO THE PUBLIC DOMAIN, * [] [] * BUT ALL COMMERCIAL RIGHTS ARE RESERVED BY THE AUTHOR * [] [] **************************nces to /// specific information are denoted by the [] [] phrase '[///]'. [] [] [] [] [] [] [] NOTES [] [] [] [] All refere [] [] [] [] Any non-printable characters in the input file are not printed [] [] (e.g., Ascii 12 (FF) will not be printed). [] OUTPUT [] [] [] [] Printing of the text file is sent to the file or printer which [] [] the user chooses. rogram starts, it reads in the keywords from this [] [] file. [] [] [] [] [] The program prompts the user for the name of the file to print. [] [] Additional Pascal keywords to highlight can be kept in the file [] [] whose name is contained in the global constant k_ExtraKeyWords. [] [] When the p [] [] [] [] INPUT [] [] [] Pretty Printer commands may also be enclosed within a file that [] [] will be printed. These commands occur within comments & start [] [] with '^'. The only defined command so far is ^FF which causes [] [] a new page to start. ile can also be printed. Various program options can [] [] be changed by the user to provide more versatile output. [] [] [] lighted [] [] in various ways (e.g., bold, underline, or italic print). [] [] [] [] This program is aimed at printing Pascal source code files, but [] [] any text fprint a header and trailer per page that [] [] include the file name, current date & time, and current page [] [] number. Each line can optionally be numbered. For Pascal [] [] source code files keywords can also optionally be high {$SETC fShowCatalog := FALSE} { Catalog available } {$SETC fHasDebug := FALSE} { Debugger installed } {$SETC fBugMinor := FALSE} { Debug minor stuff } {$SETC fCheckRange := TRUE } { Range checking } {$IFC fCheckRange} {$R+} {$ELSEC} {$R-} {$ENDC} " "{$GOTO+} "{$VARSTRING-} { ------------------------------------------------------------------------ } { External modules needed by program } USES $AppleStuff, { Apple /// system unit [///] } $ : INTEGER; { Page inch width } do_comment_cmds : BOOLEAN; { Do comment commands } line_delay : INTEGER; { Line output delay } page_delay : INTEGER; { page_start_num : INTEGER; { Starting page no. } line_start_num : INTEGER; { Starting line no. } page_length : INTEGER; { No. lines per page } page_width fanfold_paper : BOOLEAN; { Fanfold paper flag } slash_zeros : BOOLEAN; { Slash zeros flag } comment_style : t_FStyle; { Comment type style } te_and_time : t_Clock; { Clock time } trailer_phrase : t_String; { Trailer phrase } font_size : INTEGER; { Font pitch size } plain_keywords : BOOLEAN; { Plain keyword flag } keyw_font_style : t_FStyle; { Font type style } keyword_state : t_KW_State; { Keyword state } daor printer } t_KW_State = (kw_Unchanged,kw_Majuscule,kw_Minuscule); { Printing options (user controllable) } t_Options = RECORD number_lines : BOOLEAN; { Number line flag } clk_second : INTEGER; { The second [ 0... 59] } END; { Font type Style for printer } t_FStyle = (fs_Plain,fs_Underline,fs_Bold,fs_Italic); { Keyword state f... 12] } clk_day : INTEGER; { The day [ 1... 31] } clk_hour : INTEGER; { The hour [ 0... 23] } clk_minute : INTEGER; { The minute [ 0... 59] } t_BigINTEGER = INTEGER[10]; { Clock date & time information } t_Clock = RECORD clk_year : INTEGER; { The year [1453...2062] } clk_month : INTEGER; { The month [ 1} {^FF} { ------------------------------------------------------------------------ } TYPE { Generic character string } t_String = STRING[199]; { MUST be > 80 } { Extra large INTEGER [4 byte length] } k_StdPgMargin = 10; { Standard page left margin (in chars.) } k_Suffix = '.TEXT'; { Text file suffix [///] } k_Printer = '.PRINTER'; { Printer file name [///] } k_FileNotFound = 10; { File not found error [///] word file [///] } k_StdFtSize = 15; { Standard font size (chars per inch) [///] } k_StdPgWidth = 8; { Standard page width (in inches) [///] } k_StdPgLength = 66; { Standard page length (in lines ) [///] } ersion = '1.04'; { Program version number (X.YZ) } k_PgmAuthor = 'David T. Craig'; { Program author } k_PgmDate = '1987'; { Program compilation date } k_ExtraKeyWords = '.D3/PPKeyWords.TEXT'; { External key {$U .D2/UTS.CODE} U_TokenSearch { Pascal Token Search UNIT } {$IFC fHasDebug} , {.D1/UDEBUG.CODE} UPDebugger; {$ELSEC} ; {$ENDC} { ------------------------------------------------------------------------ } CONST k_PgmVPage output delay } end_delay : INTEGER; { Ending output delay } END; { Printer low-level commands } t_Prt_Command = (pc_Initialize, { Initialize printer } pc_Terminate, { Terminate printer } pc_Plain, { Plain (or normal) print style } pc_Underline, { Underline command mode } pc_NoUnderline, '()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_][][][][][][][][][][][][][][][][][][][][][][][][][][] } ][][][][] [] [] [] F I N I S [] [] [] [][][][][][][][][][ile,g_OutFile,g_Options,g_Error); END; UNTIL g_User_Is_Done OR (g_Error <> ts_k_NoError); END; omega; { Aufwiedersehen ... } END. { ----- PrettyPrint ----- } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][ BEGIN REPEAT { Process files until the user is done } BEGIN fetch_File_Info(g_InFile,g_OutFile,g_Options,g_User_Is_Done); IF NOT(g_User_Is_Done) THEN { Do the actual printing } print_File(g_InF][][][][][][][][][][][][][][][][][][][][][] } BEGIN { ----- PrettyPrint ----- } introduction; { Introduce yourself } alpha(g_Error); { Initialize everything } IF (g_Error = ts_k_NoError) THEN { Proceed iff initialization succeeded } [] [] [] T H E M A I N E V E N T [] [] [] [][][][][][][][][][][][][][][ptions; { Printing options } {$INCLUDE .D3/PPrint.1.TEXT} {$INCLUDE .D3/PPrint.2.TEXT} {$INCLUDE .D3/PPrint.3.TEXT} {$INCLUDE .D3/PPrint.4.TEXT} {$INCLUDE .D3/PPrint.5.TEXT} { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] g_Error : ts_Error; { Global error result } g_User_Is_Done : BOOLEAN; { User termination flag } g_InFile : t_String; { Input file name } g_OutFile : t_String; { Listing file name } g_Options : t_OFont size } { TEXT file reference type } t_TEXT_File = TEXT; { Needed for use as a procedure parameter } { ------------------------------------------------------------------------ } VAR ommand mode } pc_No0Slash, pc_NewLine, { Special command : New Line } pc_FormFeed, { Special command : Form Feed } pc_FontSize); { Special command : pc_Bold, { Bold command mode } pc_NoBold, pc_Italic, { Italic command mode } pc_NoItalic, pc_0Slash, { Zero Slash c { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] M I N O R R O U T I N E S [] [] rol code } ascii_ESC = 27; { ASCII Escape control code } BEGIN { ----- printer_Controller ----- } {$IFC fHasDebug AND fBugMinor} BP('printer_Controller'); {$ENDC} CASE pr_command OF pc_Initialize : WRITE(pr_device,t_TEXT_File; pr_command : t_Prt_Command; VAR pr_fsize : INTEGER); CONST ascii_FF = 12; { ASCII Form Feed control code } ascii_CR = 13; { ASCII Carriage Return cont | ImageWriter printer. If you use another printer, you | MUST modify the below codes as appropriate. |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE printer_Controller(VAR pr_device : | pr_command - Printer command | pr_fsize - Printer font size (used with pc_FontSize) | OUTPUT....: Printer feature performed | NOTES.....: The printer control codes are specific to the Apple |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: printer_Controller [///] [Apple IMAGEWRITER only] | PURPOSE...: Control low-level features of the printer | INPUT.....: pr_device - Printer device file referenced_BELL'); {$ENDC} WRITE(CHR(7)); { ASCII BELL character which for most terminals } { creates a sound } {$IFC fHasDebug AND fBugMinor} EP('sound_BELL'); {$ENDC} END; { ----- sound_BELL ----- } { | NOTES.....: This routine might need modification for other systems |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE sound_BELL; BEGIN { ----- sound_BELL ----- } {$IFC fHasDebug AND fBugMinor} BP('sounup'); {$ENDC} END; { ----- wait_up ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: sound_BELL | PURPOSE...: Make a noise | INPUT.....: (none) | OUTPUT....: Sound made me := b_sec; *new_time := new_time * 1000; *new_time := new_time + b_ms; * *IF b_sec < a_sec THEN new_time := new_time + 1000; END; UNTIL ( (new_time - old_time) >= (tenthsOfSecond * 100) ); {$IFC fHasDebug AND fBugMinor} EP('wait_convert the time record into a millisecond count } & &old_time := a_sec; &old_time := old_time * 1000; &old_time := old_time + a_ms; REPEAT BEGIN CLOCKINFO(a_year,a_month,a_day,a_weekday, 4a_hour,b_min,b_sec,b_ms); * *new_ti&b_min,b_sec,b_ms : INTEGER; BEGIN { ----- wait_up ----- } {$IFC fHasDebug AND fBugMinor} BP('wait_up'); {$ENDC} & &{ read the current Apple /// system time } & &CLOCKINFO(a_year,a_month,a_day,a_weekday, 0a_hour,a_min,a_sec,a_ms); & &{ |||||||||||||||||||||||||||||||||| } PROCEDURE wait_up (tenthsOfSecond : INTEGER); VAR &old_time : INTEGER[10]; &new_time : INTEGER[10]; & a_year,a_month,a_day,a_weekday, &a_hour,a_min,a_sec,a_ms : INTEGER; & [///] | PURPOSE...: Delay for a certain time duration | INPUT.....: tenthsOfSecond - Number of 1/10 second periods to delay | OUTPUT....: (none) | NOTES.....: Modify as appropriate for your system |||||||||||||||||||||||||||||||||||||| [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: wait_up CHR(ascii_ESC),'A'); { 66 lin/page } pc_Terminate : WRITE(pr_device,CHR(ascii_ESC),'A'); { 66 lin/page } pc_Plain : BEGIN WRITE(pr_device,CHR(ascii_ESC),'Y'); { No Underline } WRITE(pr_device,CHR(ascii_ESC),'"'); { No Bold } { ? NO APPLE IMAGEWRITER SUPPORT FOR ITALIC ? } END; pc_Underline : WRITE(pr_device,CHR(ascii_ESC),'X'); pc_NHAR; BEGIN { ----- charLowercase ----- } {$IFC fHasDebug AND fBugMinor} BP('charLowercase'); {$ENDC} charLowercase := ch; { Return character no matter what } IF (ch >= 'A') AND (ch <= 'Z') THEN { Convert only uppercase chars } ower cased | INPUT.....: ch - Character to make lower cased | OUTPUT....: charLowercase - Inputted character in lower case |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } FUNCTION charLowercase(ch : CHAR) : C {$IFC fHasDebug AND fBugMinor} EP('printer_Controller'); {$ENDC} END; { ----- printer_Controller ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: charLowercase | PURPOSE...: Make a character lF (pr_fsize = 15) THEN WRITE(pr_device,CHR(ascii_ESC),'q') ELSE IF (pr_fsize = 17) THEN WRITE(pr_device,CHR(ascii_ESC),'Q'); END; END; ELSE IF (pr_fsize = 12) THEN WRITE(pr_device,CHR(ascii_ESC),'E') ELSE IF (pr_fsize = 13) THEN WRITE(pr_device,CHR(ascii_ESC),'e') ELSE I IF (pr_fsize = 9) THEN WRITE(pr_device,CHR(ascii_ESC),'n') ELSE IF (pr_fsize = 10) THEN WRITE(pr_device,CHR(ascii_ESC),'N') pr_fsize := 17 ELSE pr_fsize := 13; ; ;{ return to caller the physically correct size } { Setup the printer font size as appropriate } = 13) THEN pr_fsize := 13 ELSE IF (pr_fsize > 13) AND (pr_fsize <= 15) THEN pr_fsize := 15 ELSE IF (pr_fsize > 15) AND (pr_fsize <= 17) THEN ND (pr_fsize <= 10) THEN pr_fsize := 10 ELSE IF (pr_fsize > 10) AND (pr_fsize <= 12) THEN pr_fsize := 12 ELSE IF (pr_fsize > 12) AND (pr_fsize <========================================= } { Make sure the font size is valid } IF (pr_fsize <= 9) THEN pr_fsize := 9 ELSE IF (pr_fsize > 9) A { =========================================== } { NOTE } { Change this code as needed for your printer } { ==vice,CHR(ascii_CR)); pc_FormFeed : WRITE(pr_device,CHR(ascii_FF)); { ImageWriter supports CPIs of 9,10,12,13.4,15 & 17 } pc_FontSize : BEGIN pr_fsize := ABS(pr_fsize); pc_NoItalic : BEGIN { ? NO APPLE IMAGEWRITER SUPPORT ? } END; pc_0Slash : WRITE(pr_device,CHR(ascii_ESC),'D',CHR(0),CHR(1)); pc_No0Slash : WRITE(pr_device,CHR(ascii_ESC),'Z',CHR(0),CHR(1)); pc_NewLine : WRITE(pr_deoUnderline : WRITE(pr_device,CHR(ascii_ESC),'Y'); pc_Bold : WRITE(pr_device,CHR(ascii_ESC),'!'); pc_NoBold : WRITE(pr_device,CHR(ascii_ESC),'"'); pc_Italic : BEGIN { ? NO APPLE IMAGEWRITER SUPPORT ? } END; charLowercase := CHR( ORD(ch) - ORD('A') + ORD('a') ); {$IFC fHasDebug AND fBugMinor} EP('charLowercase'); {$ENDC} END; { ----- charLowercase ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: strLowercase | PURPOSE...: Make a string lower cased | INPUT.....: s - String to make lower cased | OUTPUT....: s - Inputted string in lower case |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURord ----- } {$IFC fHasDebug AND fBugMinor} BP('print_Word'); {$ENDC} { Optimize the printing of blanks (really shortens print time) } IF (the_word = ' ') THEN WRITE(pr_device,the_word) { Send the blank straight thru } ELSE the_word : t_String; keyword : BOOLEAN); VAR dont_care : INTEGER; { Don't Care font size } pr_command : t_Prt_Command; { Low level printer command } BEGIN { ----- print_W | then word font style is handled special depending upon | the global keyword option settings. |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE print_Word(VAR pr_device : t_TEXT_File; evice - Printer device reference | the_word - Word to print | keyword - Word is a keyword flag | OUTPUT....: Word/phrase printed to printer. If word is a keyword, BugMinor} EP('strUppercase'); {$ENDC} END; { ----- strUppercase ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: print_Word | PURPOSE...: Print a word (or phrase) to the printer | INPUT.....: pr_d WHILE (i > 0) DO { Convert character-by-character until done } BEGIN s[i] := charUppercase(s[i]); { Convert a character } i := i - 1; { Point at next character } END; {$IFC fHasDebug AND f PROCEDURE strUppercase(VAR s : t_String); VAR i : 0..255; { String index } BEGIN { ----- strUppercase ----- } {$IFC fHasDebug AND fBugMinor} BP('strUppercase'); {$ENDC} i := LENGTH(s); { Convert starting at the string's end }ase | PURPOSE...: Make a string upper cased | INPUT.....: s - String to make upper cased | OUTPUT....: s - Inputted string in upper case |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } ercase := CHR( ORD(ch) - ORD('a') + ORD('A') ); {$IFC fHasDebug AND fBugMinor} EP('charUppercase'); {$ENDC} END; { ----- charUppercase ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: strUppercEGIN { ----- charUppercase ----- } {$IFC fHasDebug AND fBugMinor} BP('charUppercase'); {$ENDC} charUppercase := ch; { Return character no matter what } IF (ch >= 'a') AND (ch <= 'z') THEN { Convert only lowercase chars } charUpp | INPUT.....: ch - Character to make upper cased | OUTPUT....: charUppercase - Inputted character in upper case |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } FUNCTION charUppercase(ch : CHAR) : CHAR; BEP('strLowercase'); {$ENDC} END; { ----- strLowercase ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: charUppercase | PURPOSE...: Make a character upper cased ILE (i > 0) DO { Convert character-by-character until done } BEGIN s[i] := charLowercase(s[i]); { Convert a character } i := i - 1; { Point at next character } END; {$IFC fHasDebug AND fBugMinor} E strLowercase(VAR s : t_String); VAR i : 0..255; { String index } BEGIN { ----- strLowercase ----- } {$IFC fHasDebug AND fBugMinor} BP('strLowercase'); {$ENDC} i := LENGTH(s); { Convert starting at the string's end } WH BEGIN pr_command := pc_Plain; { Assume word is not special } { Setup the word type style } IF keyword AND NOT(g_Options.plain_keywords) THEN BEGIN CASE g_Options.keyw_font_style OF fs_Underline : pr_command := pc_Underline; fs_Bold : pr_command := pc_Bold; fs_Italic : pr_command := pc_Italic; END; END; { Tell the printer about the word's type|||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: show_Error | PURPOSE...: Display some information about an error condition | INPUT.....: err_msg - Error message | error - Error number | OUTPUT....: Error informatiAD(KEYBOARD,ch); 2UNTIL ch IN ['C','c']; 0END; ,END; (END &ELSE (user_STOP := FALSE; { no key was pressed, so user can't quit } {$IFC fHasDebug AND fBugMinor} EP('user_STOP'); {$ENDC} END; { ----- user_STOP ----- } { ||||||||||||||||||||*ELSE ,BEGIN .user_STOP := FALSE; { Quit key not pressed, so ... } . .IF ch IN ['P','p'] THEN { Pause key pressed } 0BEGIN 2cp('Printing has Paused; Press to Continue'); 2 2REPEAT { wait until user presses Continue key } 4IF KEYPRESS THEN RE{ test for a keypress by the user } & &IF KEYPRESS THEN (BEGIN *{ a key was pressed, so read the pressed key } * *READ(KEYBOARD,ch); * *{ test for Quit, Pause, or Continue } * *IF ch IN ['Q','q'] THEN * user_STOP := TRUE { Quit key pressed } brand of hardware. |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } FUNCTION user_STOP : BOOLEAN; " $VAR &ch : CHAR; BEGIN { ----- user_STOP ----- } {$IFC fHasDebug AND fBugMinor} BP('user_STOP'); {$ENDC} & &l if the user has pressed the STOP key(s) | INPUT.....: (none) | OUTPUT....: TRUE returned if STOP key (user defined) was pressed | NOTES.....: This routine is specific to every computer system. Thus, | you MUST rewrite it for your own {$IFC fHasDebug AND fBugMinor} EP('cp'); {$ENDC} END; { ----- cp ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: user_STOP [///] | PURPOSE...: Signa VAR padding : INTEGER; BEGIN { ----- cp ----- } {$IFC fHasDebug AND fBugMinor} BP('cp'); {$ENDC} FOR padding := 1 TO ( (screen_width - LENGTH(phrase)) DIV 2 ) DO WRITE(' '); ( WRITELN(phrase); se on the current screen line | INPUT.....: phrase - Phrase to center | OUTPUT....: Phrase centered |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE cp(phrase : t_String); CONST screen_width = 80; mmand,dont_care); END; {$IFC fHasDebug AND fBugMinor} EP('print_Word'); {$ENDC} END; { ----- print_Word ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: cp | PURPOSE...: Center a phra fs_Underline : pr_command := pc_NoUnderline; fs_Bold : pr_command := pc_NoBold; fs_Italic : pr_command := pc_NoItalic; END; END; printer_Controller(pr_device,pr_coe to the standard style } pr_command := pc_Plain; { Assume word is not special } IF keyword AND NOT(g_Options.plain_keywords) THEN BEGIN CASE g_Options.keyw_font_style OF } END; kw_Majuscule : strUppercase(the_word); kw_Minuscule : strLowercase(the_word); END; END; { Print the word } WRITE(pr_device,the_word); { Restore the type styl style } printer_Controller(pr_device,pr_command,dont_care); { Setup the word state } IF keyword THEN BEGIN CASE g_Options.keyword_state OF kw_Unchanged : BEGIN { ??? DON'T CARE ???on shown |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE show_Error(err_msg : t_String; error : ts_Error); BEGIN { ----- show_Error ----- } {$IFC fHasDebug AND fBugMinor} BP('show_Error'); {$ENDC} sound_BELL; & WRITELN; WRITELN('*** ERROR # ',error:1,' [',err_msg,']'); WRITELN; {$IFC fHasDebug AND fBugMinor} EP('show_Error'); {$ENDC} END; { ----- show_Error ----- } { ||||||||||||||||||||||||||||||||||||||||||||| instances of ch in string s returned |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } FUNCTION count_String_Character(s : t_String; ch : CHAR) : INTEGER; VAR c_count : INTEGER; c_index : INTEGER; BEGIN |||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: count_String_Character | PURPOSE...: Count occurances of a character in a string | INPUT.....: s - String to process | ch - Character to count | OUTPUT....: Number of WHILE i > 0 DO BEGIN IF ORD(s[i]) < 32 THEN DELETE(s,i,1); i := i - 1; END; {$IFC fHasDebug AND fBugMinor} EP('trim_ControlCodes'); {$ENDC} END; { ----- trim_ControlCodes ----- } { |||||||||||||||||||| PROCEDURE trim_ControlCodes(VAR s : ts_Phrase); VAR i : 0..255; { String index } BEGIN { ----- trim_ControlCodes ----- } {$IFC fHasDebug AND fBugMinor} BP('trim_ControlCodes'); {$ENDC} i := LENGTH(s); |||||||||| | ROUTINE...: trim_ControlCodes | PURPOSE...: Remove all control code characters from a string | INPUT.....: s - String to trim | OUTPUT....: s - Trimmed string |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } i := i - 1; { Point at the next character } END; END; {$IFC fHasDebug AND fBugMinor} EP('trim_Trailing'); {$ENDC} END; { ----- trim_Trailing ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| IF s[i] = charToTrim THEN { Match found ? } DELETE(s,i,1) { Yes, so trim character } ELSE i := 0; { No, so stop } IF (i > 0) THEN NGTH(s) > 0) { Trim only real strings } THEN BEGIN i := LENGTH(s); { Trim from the end to the start } WHILE (i > 0) DO { Trim until trimming is done } BEGIN trim_Trailing(VAR s : t_String; charToTrim : CHAR); VAR i : 0..255; { String index } BEGIN { ----- trim_Trailing ----- } {$IFC fHasDebug AND fBugMinor} BP('trim_Trailing'); {$ENDC} IF (LEacter from a string | INPUT.....: s - String to trim | charToTrim - Character to trim from string | OUTPUT....: s - Trimmed string |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE {$IFC fHasDebug AND fBugMinor} EP('trim_Leading'); {$ENDC} END; { ----- trim_Leading ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: trim_Trailing | PURPOSE...: Remove specified trailing charD fBugMinor} BP('trim_Leading'); {$ENDC} IF (LENGTH(s) > 0) { Trim only real strings } THEN BEGIN WHILE (LENGTH(s) > 0) AND (s[1] = charToTrim) DO DELETE(s,1,1); END; immed string |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE trim_Leading(VAR s : t_String; charToTrim : CHAR); BEGIN { ----- trim_Leading ----- } {$IFC fHasDebug AN||||||||||||||||||||||||||| | ROUTINE...: trim_Leading | PURPOSE...: Remove specified leading character from a string | INPUT.....: s - String to trim | charToTrim - Character to trim from string | OUTPUT....: s - Tr{ ----- count_String_Character ----- } {$IFC fHasDebug AND fBugMinor} BP('count_String_Character'); {$ENDC} c_count := 0; IF (LENGTH(s) > 0) THEN BEGIN c_index := 0; REPEAT BEGIN c_index := c_index + 1; c_count := c_count + ORD(s[c_index] = ch); END; UNTIL (c_index = LENGTH(s)); END; count_String_Character := c_count; {$IFC fHasDebug AND fBugMinor} EP('count_St BEGIN i := i + 1; conv_ok := (s[i] IN ['0'..'9']); IF conv_ok THEN result := (result * 10) + ORD(s[i]) - ORD('0'); END; = '-') OR (s[1] = '+') THEN DELETE(s,1,1); conv_ok := (LENGTH(s) > 0); IF conv_ok THEN BEGIN IF (LENGTH(s) > 0) THEN BEGIN i := 0; REPEAT BEGIN IF (POS(' ',s) > 0) THEN DELETE(s,POS(' ',s),1); END; UNTIL (POS(' ',s) = 0); conv_ok := (LENGTH(s) > 0); IF conv_ok THEN BEGIN negative := (s[1] = '-'); IF (s[1] result : INTEGER; negative : BOOLEAN; BEGIN { ----- string_To_Int ----- } {$IFC fHasDebug AND fBugMinor} BP('string_To_Int'); {$ENDC} result := 0; trim_Leading (s,' '); trim_Trailing(s,' '); REPEAT then converted integer returned |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } FUNCTION string_To_Int( s : t_String; VAR conv_ok : BOOLEAN) : INTEGER; VAR i : INTEGER; |||||||||||||||||||||||||| | ROUTINE...: string_To_Int | PURPOSE...: Convert a numeric string to an integer | INPUT.....: s - Numeric string to convert | OUTPUT....: conv_ok - Conversion OK flag (TRUE -> OK) | If conv_ok = TRUE, { Remove unused leading characters from numeric string } DELETE(numString,1,position); {$IFC fHasDebug AND fBugMinor} EP('int_To_String'); {$ENDC} END; { ----- int_To_String ----- } { |||||||||||||||||||||||||||||||||||||||||||||| UNTIL number = 0; { Stop conversion when number converted } IF negative { Handle negative numbers } THEN BEGIN numString[position] := neg_Sign; position := position - 1; END; REPEAT { Convert number one digit at a time to a numeric string } BEGIN numString[position] := CHR(ORD('0') + (number MOD 10)); position := position - 1; number := number DIV 10; END; C fCheckRange} {$R+} {$ENDC} & position := max_StrLength; { Init string digit index } negative := (number < 0); { Init negative flag } number := ABS(number); { Convert only pos. numbers } BEGIN { ----- int_To_String ----- } {$IFC fHasDebug AND fBugMinor} BP('int_To_String'); {$ENDC} & &{ borrowed from the source code for Apple's ToolKit/32 } {$R-} &numString[0] := CHR(max_StrLength); { Init numeric string length } &{$IFegative sign } max_StrLength = 11; { 10 digit characters + 1 sign character } VAR negative : BOOLEAN; { Negative number flag } position : 1..max_StrLength; { Numeric string index } Integer to convert | OUTPUT....: numString - Numeric string |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE int_To_String(number : INTEGER; VAR numString : t_String); CONST neg_Sign = '-'; { Nring_Character'); {$ENDC} END; { ----- count_String_Character ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: int_To_String | PURPOSE...: Convert an INTEGER to a string | INPUT.....: number - UNTIL (i = LENGTH(s)) OR NOT(conv_ok); END; IF negative THEN result := -result; END; END; IF NOT(conv_ok) THEN string_To_Int := 0 ELSE string_To_Int := result; {$IFC fHasDebug AND fBugMinor} EP('string_To_Int'); {$ENDC} END; { ----- string_To_Int ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: read_CLOCK [///]te*ORD((clk_minute>=0) AND (clk_minute<=59)); int_To_String(clk_minute,numString); pad_String(2,'0',numString); clk_string := CONCAT(clk_string,numString,':'); clk_second := clk_second*ORD((clk_second>=0) AND (clk_second<=umString,' '); clk_hour := clk_hour*ORD((clk_hour>=0) AND (clk_hour<=23)); int_To_String(clk_hour ,numString); pad_String(2,'0',numString); clk_string := CONCAT(clk_string,numString,':'); clk_minute := clk_minu clk_string := CONCAT(clk_string,month,'-'); clk_year := clk_year*ORD((clk_year>= 1453) AND (clk_year<=2062)); int_To_String(clk_year ,numString); pad_String(4,'0',numString); clk_string := CONCAT(clk_string,nring } BEGIN clk_day := clk_day*ORD((clk_day>=1) AND (clk_day<=31)); int_To_String(clk_day ,numString); pad_String(2,'0',numString); clk_string := CONCAT(clk_string,numString,'-'); 'AUG'; 9 : month := 'SEP'; 10 : month := 'OCT'; 11 : month := 'NOV'; 12 : month := 'DEC'; OTHERWISE month := '???'; { MUST have a length of 3 } END; WITH chronos DO { Convert each numeric item to a st CASE chronos.clk_month OF 1 : month := 'JAN'; 2 : month := 'FEB'; 3 : month := 'MAR'; 4 : month := 'APR'; 5 : month := 'MAY'; 6 : month := 'JUN'; 7 : month := 'JUL'; 8 : month := END; { ----- pad_String ----- } { ------------------------------------------------------------------------ } BEGIN { ----- get_CLOCK_String ----- } {$IFC fHasDebug AND fBugMinor} BP('get_CLOCK_String'); {$ENDC} clk_string := ''; : STRING[1]; BEGIN { ----- pad_String ----- } small_string := '?'; small_string[1] := filler; WHILE (LENGTH(s) < padding) DO BEGIN s := CONCAT(small_string,s); END; g; { ------------------------------------------------------------------------ } PROCEDURE pad_String( padding : INTEGER; filler : CHAR; VAR s : t_String); VAR small_strings' |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE get_CLOCK_String( chronos : t_Clock; VAR clk_string : t_String); VAR month : STRING[3]; numString : t_Strin | ROUTINE...: get_CLOCK_String | PURPOSE...: Convert clock information to a string | INPUT.....: chronos - Numeric clock information | OUTPUT....: clk_string - Clock date & time as a string | NOTES.....: Format of string = 'dd-MMM-yyyy hh:mm:sclk_hour,clk_minute,clk_second,dont_care); {$IFC fHasDebug AND fBugMinor} EP('read_CLOCK'); {$ENDC} END; { ----- read_CLOCK ----- } {$ENDC} { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| PROCEDURE read_CLOCK(VAR chronos : t_Clock); " $VAR &dont_care : INTEGER; BEGIN { ----- read_CLOCK ----- } {$IFC fHasDebug AND fBugMinor} BP('read_CLOCK'); {$ENDC} WITH chronos DO (CLOCKINFO(clk_year,clk_month,clk_day,dont_care, 2 | PURPOSE...: Read the date & time from the system clock | INPUT.....: (none) | OUTPUT....: chronos - Current system date & time | NOTES.....: (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } {$IFC fHasClock} 59)); int_To_String(clk_second,numString); pad_String(2,'0',numString); clk_string := CONCAT(clk_string,numString); END; {$IFC fHasDebug AND fBugMinor} EP('get_CLOCK_String'); {$ENDC} O^ŰŰEGIN the_month := 3; GOTO 1; END; IF (month_str = 'APR') THEN BEGIN the_month := 4; GOTO 1; END; IF (month_str = 'MAY') THEN BEGIN the_month := 5; GOTO 1; END; IF (month_str = 'JUN') THEN BEGIN the_month := 6; GOTO 1; END; etters } { Test the month string against the valid month names } IF (month_str = 'JAN') THEN BEGIN the_month := 1; GOTO 1; END; IF (month_str = 'FEB') THEN BEGIN the_month := 2; GOTO 1; END; IF (month_str = 'MAR') THEN B the_month : INTEGER; BEGIN { ----- test_month ----- } {$IFC fHasDebug AND fBugMinor} BP('test_month'); {$ENDC} the_month := 0; { Assume month string is INVALID } strUppercase(month_str); { Must be in all majuscule l; number : INTEGER; { ------------------------------------------------------------------------ } FUNCTION test_month(month_str : t_String) : INTEGER; LABEL 1; { Use the good old GOTO statement, a la Dijkstra } VAR string : t_String; VAR chronos : t_Clock; VAR parse_ok : BOOLEAN); VAR minus_count : INTEGER; marker_1 : INTEGER; marker_2 : INTEGER; phrase : t_Stringructure | parse_ok - Parsing OK flag (TRUE -> OK) | NOTES.....: Format of input string = 'dd-MMM-yyyy', eg. '11-OCT-1962' |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE parse_Date_String( clk_ { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: parse_Date_String | PURPOSE...: Parse a string date into a numeric date | INPUT.....: clk_string - Date as a string | OUTPUT....: chronos - Numeric date stacdefghijklmnopqrstuvwxyz{|}~O^Ű IF (month_str = 'JUL') THEN BEGIN the_month := 7; GOTO 1; END; IF (month_str = 'AUG') THEN BEGIN the_month := 8; GOTO 1; END; IF (month_str = 'SEP') THEN BEGIN the_month := 9; GOTO 1; END; IF (month_str = 'OCT') THEN BEGIN the_month := 10; GOTO 1; END; IF (month_str = 'NOV') THEN BEGIN the_month := 11; GOTO 1; END; IF (month_str = 'DEC') THEN BEGIN the_month := 12; GOTO 1; END; 1: test_month := the_month; { R||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE parse_Time_String( clk_string : t_String; VAR chronos : t_Clock; VAR parse_ok : BOOLEAN); VAR colon_count : INTEing | INPUT.....: clk_string - String time to parse | OUTPUT....: chronos - Numeric time structure | parse_ok - Parsing OK flag (TRUE -> OK) | NOTES.....: Format of input string = 'hh:mm:ss', eg, '5:23:12' ||||||||||||||||||||||| {$IFC fHasDebug AND fBugMinor} EP('parse_Date_String'); {$ENDC} END; { ----- parse_Date_String ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: parse_Time_String | PURPOSE...: Parse a time str parse_ok THEN chronos.clk_year := number; END; END; END; END; END; END; END; ; IF parse_ok THEN BEGIN parse_ok := (number >= 1453) AND (number <= 2062); IF phrase := COPY(clk_string, { Test year number } marker_2 + 1, LENGTH(clk_string) - marker_2); number := string_To_Int(phrase,parse_ok) parse_ok := ((number >= 1) AND (number <= 12)); IF parse_ok THEN BEGIN chronos.clk_month := number; { Have month } marker_2 - marker_1 - 1); parse_ok := (LENGTH(phrase) = 3); IF parse_ok THEN BEGIN number := test_month(phrase); clk_string[marker_1] := CHR(255); marker_2 := POS('-',clk_string); { Test month name } phrase := COPY(clk_string, marker_1 + 1, ); number := string_To_Int(phrase,parse_ok); parse_ok := ((number >= 1) AND (number <= 31)); IF parse_ok THEN BEGIN chronos.clk_day := number; { Have day } IF parse_ok THEN BEGIN marker_1 := POS('-',clk_string); { Test day number } phrase := COPY(clk_string, 1, marker_1 - 1,POS(' ',clk_string),1); parse_ok := (LENGTH(clk_string) > 0); IF parse_ok THEN BEGIN minus_count := count_String_Character(clk_string,'-'); parse_ok := (minus_count = 2); ---- } {$IFC fHasDebug AND fBugMinor} BP('parse_Date_String'); {$ENDC} parse_ok := (LENGTH(clk_string) > 0); IF parse_ok THEN BEGIN WHILE (POS(' ',clk_string) > 0) DO { Remove all blanks } DELETE(clk_stringeturn the matched month's number } {$IFC fHasDebug AND fBugMinor} EP('test_month'); {$ENDC} END; { ----- test_month ----- } { ------------------------------------------------------------------------ } BEGIN { ----- parse_Date_String -GER; marker_1 : INTEGER; marker_2 : INTEGER; phrase : t_String; number : INTEGER; BEGIN { ----- parse_Time_String ----- } {$IFC fHasDebug AND fBugMinor} BP('parse_Time_String'); {$ENDC} parse_ok := (LENGTH(clk_string) > 0); IF parse_ok THEN BEGIN WHILE (POS(' ',clk_string) > 0) DO { Remove all blanks } DELETE(clk_string,POS(' ',clk_string),1); parse_ok := (LENGTH(clk_string) > 0); nute := number; phrase := COPY (clk_string, { 'ss' } marker_2 + 1, LENGTH(clk_string,parse_ok); IF parse_ok AND (number >= 0) AND (number <= 59) THEN BEGIN chronos.clk_mi phrase := COPY(clk_string, { 'mm' } marker_1 + 1, marker_2 - marker_1 - 1); number := string_To_Int(phrase IF parse_ok AND (number >= 0) AND (number <= 23) THEN BEGIN chronos.clk_hour := number; phrase := COPY(clk_string, { 'hh' } 1, marker_1 - 1); number := string_To_Int(phrase,parse_ok); 2 : BEGIN { 'hh:mm:ss' } marker_1 := POS(':',clk_string); clk_string[marker_1] := CHR(255); marker_2 := POS(':',clk_string); (number <= 59) THEN BEGIN chronos.clk_minute := number; END; END; END; 8 LENGTH(clk_string) - marker_1); number := string_To_Int(phrase,parse_ok); IF parse_ok AND (number >= 0) AND THEN BEGIN chronos.clk_hour := number; phrase := COPY(clk_string, { 'mm' } marker_1 + 1, marker_1 - 1); number := string_To_Int(phrase,parse_ok); IF parse_ok AND (number >= 0) AND (number <= 23) END; 8 1 : BEGIN { 'hh:mm' } marker_1 := POS(':',clk_string); phrase := COPY(clk_string, { 'hh' } 1, BEGIN chronos.clk_hour := number; chronos.clk_minute := 0; chronos.clk_second := 0; END; 0 : BEGIN { 'hh' } number := string_To_Int(clk_string,parse_ok); IF parse_ok AND (number >= 0) AND (number <= 23) THEN IF parse_ok THEN BEGIN colon_count := count_String_Character(clk_string,':'); parse_ok := (colon_count <= 2); IF parse_ok THEN BEGIN CASE colon_count OF )-marker_2); number := string_To_Int(phrase,parse_ok); IF parse_ok AND (number >= 0) AND (number <= 59) THEN BEGIN chronos.clk_second := number; END; END; ENGTH(a_string) < 4) DO a_string := CONCAT('0',a_string); get_CLOCK_String(date_time,title_string); a_string := CONCAT('< ',title_string,' > ',k_PageTitle,a_string); title_string := ''; { Empty string } FOR char_counter := g_Options.font_size * g_Options.page_width; printer_Controller(pr_device,pc_Bold,char_counter); print_Divider_Line(pr_device,chars_per_line); print_Left_Margin(pr_device); int_To_String(page_number,a_string); WHILE (L chars_per_line : INTEGER; char_counter : INTEGER; title_string : t_String; a_string : t_String; BEGIN { ----- print_Header ----- } {$IFC fHasDebug AND fBugMinor} BP('print_Header'); {$ENDC} chars_per_line file_name : t_String; date_time : t_Clock; page_number : INTEGER); CONST k_FileTitle = 'File - '; k_PageTitle = 'Page - '; VAR date_time - Printing date & time | page_number - Page number | OUTPUT....: (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE print_Header(VAR pr_device : t_TEXT_File; ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: print_Header | PURPOSE...: Print the header for a page | INPUT.....: pr_device - Printer device reference | file_name - Name of printing file | FOR char_counter := 1 TO (chars_per_line - k_StdPgMargin) DO WRITE(pr_device,divider_char); WRITELN(pr_device); {$IFC fHasDebug AND fBugMinor} EP('print_Divider_Line'); {$ENDC} END; { ----- print_Divider_Line ----- } { |||ER); CONST divider_char = '='; VAR char_counter : INTEGER; BEGIN { ----- print_Divider_Line ----- } {$IFC fHasDebug AND fBugMinor} BP('print_Divider_Line'); {$ENDC} print_Left_Margin(pr_device); ine - No. of characters per line | OUTPUT....: (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE print_Divider_Line(VAR pr_device : t_TEXT_File; chars_per_line : INTEG----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: print_Divider_Line | PURPOSE...: Print a header/trailer divider line | INPUT.....: pr_device - Printer device reference | chars_per_l {$IFC fHasDebug AND fBugMinor} BP('print_Left_Margin'); {$ENDC} FOR char_counter := 1 TO k_StdPgMargin DO WRITE(pr_device,' '); {$IFC fHasDebug AND fBugMinor} EP('print_Left_Margin'); {$ENDC} END; { ----- print_Left_Margin ft margin constant |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE print_Left_Margin(VAR pr_device : t_TEXT_File); VAR char_counter : INTEGER; BEGIN { ----- print_Left_Margin ----- } ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: print_Left_Margin | PURPOSE...: Print the left margin of a printed line | INPUT.....: pr_device - Printer device reference | OUTPUT....: Left margin printed using global le END; END; END; END; END; END; {$IFC fHasDebug AND fBugMinor} EP('parse_Time_String'); {$ENDC} END; { ----- parse_Time_String ----- } { ||||||||||| := 1 TO (chars_per_line - k_StdPgMargin - LENGTH(k_FileTitle) - LENGTH(file_name) - LENGTH(a_string)) DO title_string := CONCAT(title_string,' '); title_string := CONCAT(k_FileTitle,file_name,title_string,a_string); WRITELN(pr_device,title_string); print_Divider_Line(pr_device,chars_per_line); printer_Controller(pr_device,p` { <<<<<< END OF FILE : PrettyPrint.2 >>>>>> } _phrase); print_Divider_Line(pr_device,chars_per_line); printer_Controller(pr_device,pc_NoBold,char_counter); {$IFC fHasDebug AND fBugMinor} EP('print_Trailer'); {$ENDC} END; { ----- print_Trailer ----- } LENGTH(g_Options.trailer_phrase)) DIV 2) DO WRITE(pr_device,' '); IF last_page THEN WRITELN(pr_device,g_Options.trailer_phrase,' ',k_FinisPhrase) ELSE WRITELN(pr_device,g_Options.trailere } printer_Controller(pr_device,pc_Bold,char_counter); print_Divider_Line(pr_device,chars_per_line); print_Left_Margin(pr_device); FOR char_counter := 1 TO ((chars_per_line - k_StdPgMargin - char_counter : INTEGER; BEGIN { ----- print_Trailer ----- } {$IFC fHasDebug AND fBugMinor} BP('print_Trailer'); {$ENDC} chars_per_line := g_Options.font_size * g_Options.page_width; WRITELN(pr_device); { Print empty top lin|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE print_Trailer(last_page : BOOLEAN; VAR pr_device : t_TEXT_File); CONST k_FinisPhrase = '<<< F I N I S >>>'; VAR chars_per_line : INTEGER; ||| | ROUTINE...: print_Trailer | PURPOSE...: Print a page trailer | INPUT.....: last_page - Last page was printed flag | pr_device - Printer device reference | OUTPUT....: Trailer printed using global trailer option phrase ||||||||c_NoBold,char_counter); WRITELN(pr_device); { Print empty bottom line } {$IFC fHasDebug AND fBugMinor} EP('print_Header'); {$ENDC} END; { ----- print_Header ----- } { ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] M A J O R R O U T I N E S [] [] fanfold_paper := TRUE; slash_zeros := TRUE; comment_style := fs_Italic; page_start_num := 1; line_start_num := 1; page_length := k_StdPgLength; page_width { Highlight keywords } keyword_state := kw_Majuscule; { Uppercase keywords } trailer_phrase := k_DefaultBottomPhrase; font_size := k_StdFtSize; keyw_font_style := fs_Bold; { Initialize the user-changable options } IF (error = ts_k_NoError) THEN BEGIN WITH g_Options DO BEGIN number_lines := TRUE; { Number each line } plain_keywords := FALSE; und) THEN error := ts_k_NoError { Ignore non-existant keyword file } ELSE BEGIN IF (error <> ts_k_NoError) THEN show_Error('Initializing program',error); END; ug} BP('alpha'); {$ENDC} { Initialize the token search unit & load the external tokens } & &cp('Initializing keyword tokens & loading external keywords...'); error := TS_InitializeTokenSearch(k_ExtraKeyWords); IF (error = k_FileNotFoord searcher setup |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE alpha(VAR error : ts_Error); CONST k_DefaultBottomPhrase = '( Have a good day )'; BEGIN { ----- alpha ----- } {$IFC fHasDeb{ |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: alpha | PURPOSE...: Initialize the program | INPUT.....: (none) | OUTPUT....: error - Initialize error result | NOTES.....: Global printing options & token wK_String(chronos,clk_string); cp(CONCAT('The current date and time is ',clk_string)); {$ENDC} {$IFC fHasDebug} EP('introduction'); {$ENDC} END; { ----- introduction ----- } {^FF} scal keywords can be highlighted. '); WRITELN; cp('--- NOTE ---'); cp(CONCAT ('Optional keyword list can be kept in file "',k_ExtraKeyWords,'"')); WRITELN; {$IFC fHasClock} read_CLOCK(chronos); get_CLOC------------------------------------------'); WRITELN; cp('This program prints a Pascal source code file to a printer in a '); cp('very "pretty" manner. I.e., a header, trailer, and line numbers'); cp('are printed. Optionally, Pa cp('----------------------------------------------------------------'); cp(CONCAT('Pascal Pretty Printer Utility ', k_PgmVersion,' [',k_PgmDate,']')); cp(CONCAT('Written by ',k_PgmAuthor)); cp('----------------------on ----- } {$IFC fHasDebug} PD_InitDebugger; PD_Writeln('Welcome to the PrettyPrint Debugger'); PD_Writeln(''); &BP('Introduction'); {$ENDC} WRITELN; program to the user | INPUT.....: (none) | OUTPUT....: (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE introduction; VAR chronos : t_Clock; (clk_string : t_String; BEGIN { ----- introducti [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: introduction | PURPOSE...: Introduce the := k_StdPgWidth; do_comment_cmds := TRUE; line_delay := 2; { 1/10 second delay } page_delay := 40; { 1/10 second delay } end_delay := 100; { 1/10 second delay } {$IFC fHasClock} read_CLOCK(date_and_time); { Read current clock time } {$ELSEC} WITH date_and_time DO BEGIN { Initialize the clock time to a famous date } clk_year O^ŰŰ Keyword files are text files * [2] All lines starting with an '*' are comments * [3] Each keyword occupies one line * [4] Keyword case is unimportant * [5] Other keyword files may be included by using a line as; * >>>>> } BEGIN { ----- omega ----- } {$IFC fHasDebug} BP('omega'); {$ENDC} error := TS_TerminateTokenSearch; IF (error <> ts_k_NoError) THEN show_Error('Terminating program',error); WRITELN; WRITELN('That''s all, Folks..||||| | ROUTINE...: omega | PURPOSE...: Terminate the program | INPUT.....: (none) | OUTPUT....: (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE omega; VAR error : ts_Error; clk_second := 0; END; {$ENDC} END; END; {$IFC fHasDebug} EP('alpha'); {$ENDC} END; { ----- alpha ----- } {^FF} { ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| := 1453; { Constantine XI } clk_month := 5; { of Constantinople } clk_day := 29; { May 29, 1453 } clk_hour := 12; { High Noon } clk_minute := 0; { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: fetch_File_Info | PURPOSE...: Fetch input & output file names and modify options | INPUT.....: (none) | OUTPUT....: in_file - Input file name | <> 'y'); {$IFC fHasDebug} EP('do_01_Option'); {$ENDC} END; { ----- do_01_Option ----- } { ------------------------------------------------------------------------ } PROCEDURE do_02_Option; { Keyword state } BEGlight keywords (Y/N) [Y] ? '); READLN(s); IF (s = '') THEN g_Options.plain_keywords := FALSE ELSE g_Options.plain_keywords := (s[1] <> 'Y') AND (s[1]{ ------------------------------------------------------------------------ } PROCEDURE do_01_Option; { Plain keywords } BEGIN { ----- do_01_Option ----- } {$IFC fHasDebug} BP('do_01_Option'); {$ENDC} WRITE('High PROCEDURE do_Options(opt_command : INTEGER); VAR s : t_String; date_time : t_String; chronos : t_Clock; { Default date & time } number : INTEGER; parse_ok : BOOLEAN; ------------------------------------ } PROCEDURE handle_Options; VAR numString : t_String; conv_ok : BOOLEAN; option_cmd : INTEGER; { ------------------------------------------------------------------------ } BEGIN CLOSE(f_ref); file_Exists := TRUE; END ELSE file_Exists := FALSE; {$IFC fHasDebug} EP('file_Exists'); {$ENDC} END; { ----- file_Exists ----- } { ------------------------------------ io_error : ts_Error; f_ref : TEXT; BEGIN { ----- file_Exists ----- } {$IFC fHasDebug} BP('file_Exists'); {$ENDC} RESET(f_ref,which_file); io_error := IORESULT; IF (io_error = ts_k_NoError) THEN C fHasDebug} EP('add_File_Extension'); {$ENDC} END; { ----- add_File_Extension ----- } { ------------------------------------------------------------------------ } FUNCTION file_Exists(which_file : t_String) : BOOLEAN; VAR not really be a suffix } suffix_length := LENGTH(k_Suffix); IF ((LENGTH(the_file)-suffix_posn+1) <> suffix_length) THEN the_file := CONCAT(the_file,k_Suffix); END; END; {$IFe } ELSE BEGIN suffix_posn := POS(k_Suffix,the_file); IF (suffix_posn = 0) THEN the_file := CONCAT(the_file,k_Suffix) { Add suffix } ELSE BEGIN { Suffix found, but it might BEGIN { ----- add_File_Extension ----- } {$IFC fHasDebug} BP('add_File_Extension'); {$ENDC} strUppercase(the_file); IF (the_file[LENGTH(the_file)] = '.') THEN DELETE(the_file,LENGTH(the_file),1) { Use shortened namnswer to QUIT question } { ------------------------------------------------------------------------ } PROCEDURE add_File_Extension(VAR the_file : t_String); VAR suffix_posn : INTEGER; suffix_length : INTEGER; || } PROCEDURE fetch_File_Info(VAR in_file : t_String;  quit) ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||IN { ----- do_02_Option ----- } {$IFC fHasDebug} BP('do_02_Option'); {$ENDC} WRITE('Keyword state (Unchanged,Capitalized,Lowercased) ', '[Capitalized] ? '); READLN(s); IF (s = '') THEN s := 'C'; strUppercase(s); IF (LENGTH(s) > 1) THEN DELETE(s,2,LENGTH(s) - 1); WITH g_Options DO BEGIN IF (s = 'U') THEN keyword_state := kw_Unchanged; DLN(s); IF (s <> '') THEN parse_Time_String(s,chronos,parse_ok); IF NOT(parse_ok) THEN BEGIN WRITELN('*** Warning - Invalid time string'); chronos 1, POS(' ',s)); date_time := s; REPEAT BEGIN parse_ok := TRUE; WRITE('Current time (hh:mm:ss) ', '[',date_time,'] ? '); REA IF parse_ok AND (s <> '') THEN g_Options.date_and_time := chronos; { Prompt user for current TIME } get_CLOCK_String(g_Options.date_and_time,s); DELETE(s, { Extract time part } parse_ok) THEN BEGIN WRITELN('*** Warning - Invalid date string'); chronos := g_Options.date_and_time; END; END; UNTIL parse_ok OR (s = ''); e_ok := TRUE; WRITE('Current date (dd-MMM-yyyy) ', '[',date_time,'] ? '); READLN(s); IF (s <> '') THEN parse_Date_String(s,chronos,parse_ok); IF NOT(et_CLOCK_String(g_Options.date_and_time,s); DELETE(s, { Extract date part } POS(' ',s), LENGTH(s) - POS(' ',s) + 1); date_time := s; REPEAT BEGIN pars WRITELN('*** Note - Your system has a built-in clock !'); {$ELSEC} { Initialize user's current date & time } chronos := g_Options.date_and_time; { Prompt user for current DATE } g-------------------------- } PROCEDURE do_04_Option; { Current date } BEGIN { ----- do_04_Option ----- } {$IFC fHasDebug} BP('do_04_Option'); {$ENDC} {$IFC fHasClock} sound_BELL; , 'I' : g_Options.keyw_font_style := fs_Italic; END; END; {$IFC fHasDebug} EP('do_03_Option'); {$ENDC} END; { ----- do_03_Option ----- } { ---------------------------------------------- UNTIL parse_ok OR (s = ''); IF (s <> '') AND parse_ok THEN BEGIN CASE s[1] OF 'U' : g_Options.keyw_font_style := fs_Underline; 'B' : g_Options.keyw_font_style := fs_Bold; parse_ok := (s[1] IN ['U','B','I']); END ELSE BEGIN parse_ok := TRUE; s := 'B'; { Bold } END; END; BEGIN WRITE('Keyword style (Underline,Bold,Italic) [Bold] ? '); READLN(s); IF (s <> '') THEN BEGIN strUppercase(s); --------------------------------------------------------------- } PROCEDURE do_03_Option; { Keyword Font style } BEGIN { ----- do_03_Option ----- } {$IFC fHasDebug} BP('do_03_Option'); {$ENDC} REPEAT IF (s = 'C') THEN keyword_state := kw_Majuscule; IF (s = 'L') THEN keyword_state := kw_Minuscule; END; {$IFC fHasDebug} EP('do_02_Option'); {$ENDC} END; { ----- do_02_Option ----- } { --------- := g_Options.date_and_time; END; END; UNTIL parse_ok OR (s = ''); IF parse_ok AND (s <> '') THEN g_Options.date_and_time := chronos; {$ENDC} {$IFC fHasDebug} EP('do_04_Option'); {$ENDC} END; { ----- do_04_Option ----- } { ------------------------------------------------------------------------ } PROCEDURE do_05_Option; { Trailer phrase } BEGIN { ----- do_09_Option ----- } { ------------------------------------------------------------------------ } PROCEDURE do_10_Option; { Italic comments } BEGIN { ----- do_10_Option ----- } {$IFC fHasDebug} BP('do_10_Option'); {$ENDC} THEN g_Options.slash_zeros := TRUE ELSE g_Options.slash_zeros := (s[1] = 'Y') OR (s[1] = 'y'); {$IFC fHasDebug} EP('do_09_Option'); {$ENDC} END; { ----- PROCEDURE do_09_Option; { Slashed zeros (0) } BEGIN { ----- do_09_Option ----- } {$IFC fHasDebug} BP('do_09_Option'); {$ENDC} WRITE('Slash the zeros (Y/N) [Y] ? '); READLN(s); IF (s = '') (s[1] = 'y'); {$IFC fHasDebug} EP('do_08_Option'); {$ENDC} END; { ----- do_08_Option ----- } { ------------------------------------------------------------------------ } WRITE('Number each line (Y/N) [Y] ? '); READLN(s); IF (s = '') THEN g_Options.number_lines := TRUE ELSE g_Options.number_lines := (s[1] = 'Y') OR do_07_Option ----- } { ------------------------------------------------------------------------ } PROCEDURE do_08_Option; { Line numbering } BEGIN { ----- do_08_Option ----- } {$IFC fHasDebug} BP('do_08_Option'); {$ENDC} g_Options.fanfold_paper := TRUE ELSE g_Options.fanfold_paper := (s[1] = 'Y') OR (s[1] = 'y'); {$IFC fHasDebug} EP('do_07_Option'); {$ENDC} END; { ----- PROCEDURE do_07_Option; { Fanfold paper } BEGIN { ----- do_07_Option ----- } {$IFC fHasDebug} BP('do_07_Option'); {$ENDC} WRITE('Fanfold paper (Y/N) [Y] ? '); READLN(s); IF (s = '') THEN > '') AND parse_ok THEN g_Options.font_size := number; {$IFC fHasDebug} EP('do_06_Option'); {$ENDC} END; { ----- do_06_Option ----- } { ------------------------------------------------------------------------ } IF NOT(parse_ok) THEN WRITELN('*** Warning - ', 'Pitch size is invalid or out of range'); END; END; UNTIL parse_ok OR (s = ''); IF (s < READLN(s); IF (s <> '') THEN BEGIN number := string_To_Int(s,parse_ok); IF parse_ok THEN parse_ok := (number > 0) AND (number < 50); ---- } {$IFC fHasDebug} BP('do_06_Option'); {$ENDC} REPEAT BEGIN parse_ok := TRUE; WRITE('Font pitch size ', '[',g_Options.font_size:1,'] ? '); 05_Option'); {$ENDC} END; { ----- do_05_Option ----- } { ------------------------------------------------------------------------ } PROCEDURE do_06_Option; { Font size (measured in pitch [cpi]) } BEGIN { ----- do_06_Option - do_05_Option ----- } {$IFC fHasDebug} BP('do_05_Option'); {$ENDC} WRITE('Trailer phrase ? '); READLN(s); IF (s <> '') THEN g_Options.trailer_phrase := s; {$IFC fHasDebug} EP('do_ WRITE('Italic Pascal comments (Y/N) [Y] ? '); READLN(s); IF (s <> '') THEN BEGIN IF (s[1] = 'Y') OR (s[1] = 'y') THEN g_Options.comment_style := fs_Italic ELSE g_Options.comment_style := fs_Plain; END; {$IFC fHasDebug} EP('do_10_Option'); {$ENDC} END; { ----- do_10_Option ----- } { -------------------------------------------------------- } PROCEDURE do_14_Option; { Page line width } BEGIN { ----- do_14_Option ----- } {$IFC fHasDebug} BP('do_14_Option'); {$ENDC} REPEAT BEGIN parse_ok := TRUE; WRITE( IF (s <> '') AND parse_ok THEN g_Options.page_length := number; {$IFC fHasDebug} EP('do_13_Option'); {$ENDC} END; { ----- do_13_Option ----- } { ----------------------------------------------------------------------- IF NOT(parse_ok) THEN WRITELN('*** Warning - ', 'Line count is invalid or out of range'); END; END; UNTIL parse_ok OR (s = ''); READLN(s); IF (s <> '') THEN BEGIN number := string_To_Int(s,parse_ok); IF parse_ok THEN parse_ok := (number > 0) AND (number < 132); 3_Option ----- } {$IFC fHasDebug} BP('do_13_Option'); {$ENDC} REPEAT BEGIN parse_ok := TRUE; WRITE('Page line count ', '[',g_Options.page_length:1,'] ? '); {$IFC fHasDebug} EP('do_12_Option'); {$ENDC} END; { ----- do_12_Option ----- } { ------------------------------------------------------------------------ } PROCEDURE do_13_Option; { Page line count } BEGIN { ----- do_1 'Line number is invalid or out of range'); END; END; UNTIL parse_ok OR (s = ''); IF (s <> '') AND parse_ok THEN g_Options.line_start_num := number; BEGIN number := string_To_Int(s,parse_ok); IF parse_ok THEN parse_ok := (number > 0); IF NOT(parse_ok) THEN WRITELN('*** Warning - ', ENDC} REPEAT BEGIN parse_ok := TRUE; WRITE('Starting line number ', '[',g_Options.line_start_num:1,'] ? '); READLN(s); IF (s <> '') THEN - do_11_Option ----- } { ------------------------------------------------------------------------ } PROCEDURE do_12_Option; { Starting line number } BEGIN { ----- do_12_Option ----- } {$IFC fHasDebug} BP('do_12_Option'); {$ END; END; UNTIL parse_ok OR (s = ''); IF (s <> '') AND parse_ok THEN g_Options.page_start_num := number; {$IFC fHasDebug} EP('do_11_Option'); {$ENDC} END; { ---- IF parse_ok THEN parse_ok := (number > 0); IF NOT(parse_ok) THEN WRITELN('*** Warning - ', 'Page number invalid or out of range'); WRITE('Starting page number ', '[',g_Options.page_start_num:1,'] ? '); READLN(s); IF (s <> '') THEN BEGIN number := string_To_Int(s,parse_ok); ----------------- } PROCEDURE do_11_Option; { Starting page number } BEGIN { ----- do_11_Option ----- } {$IFC fHasDebug} BP('do_11_Option'); {$ENDC} REPEAT BEGIN parse_ok := TRUE; 'Page line width (in inches) ', '[',g_Options.page_width:1,'] ? '); READLN(s); IF (s <> '') THEN BEGIN number := string_To_Int(s,parse_ok); IF parse_ok THEN parse_ok := (number > 0) AND (number < 36); IF NOT(parse_ok) THEN WRITELN('*** Warning - ', 'Page width is invalid or out oftup document end delay time } BEGIN { ----- do_18_Option ----- } {$IFC fHasDebug} BP('do_18_Option'); {$ENDC} REPEAT BEGIN parse_ok := TRUE; WRITE('Ending delay (in 1/10 seco g_Options.page_delay := number; {$IFC fHasDebug} EP('do_17_Option'); {$ENDC} END; { ----- do_17_Option ----- } { ------------------------------------------------------------------------ }  PROCEDURE do_18_Option; { Se WRITELN('*** Warning - ', 'Page delay is invalid or out of range'); END; END; UNTIL parse_ok OR (s = ''); IF (s <> '') AND parse_ok THEN BEGIN number := string_To_Int(s,parse_ok); IF parse_ok THEN parse_ok := (number >= 0) AND (number < 10*10); IF NOT(parse_ok) THEN NDC} REPEAT BEGIN parse_ok := TRUE; WRITE('Page delay (in 1/10 seconds) ', '[',g_Options.page_delay:1,'] ? '); READLN(s); IF (s <> '') THEN _16_Option ----- } { ------------------------------------------------------------------------ }  PROCEDURE do_17_Option; { Setup page delay time } BEGIN { ----- do_17_Option ----- } {$IFC fHasDebug} BP('do_17_Option'); {$E END; END; UNTIL parse_ok OR (s = ''); IF (s <> '') AND parse_ok THEN g_Options.line_delay := number; {$IFC fHasDebug} EP('do_16_Option'); {$ENDC} END; { ----- doN parse_ok := (number >= 0) AND (number < 10*5); IF NOT(parse_ok) THEN WRITELN('*** Warning - ', 'Line delay is invalid or out of range'); n 1/10 seconds) ', '[',g_Options.line_delay:1,'] ? '); READLN(s); IF (s <> '') THEN BEGIN number := string_To_Int(s,parse_ok); IF parse_ok THERE do_16_Option; { Setup line delay time } BEGIN { ----- do_16_Option ----- } {$IFC fHasDebug} BP('do_16_Option'); {$ENDC} REPEAT BEGIN parse_ok := TRUE; WRITE('Line delay (i (s[1] = 'y'); {$IFC fHasDebug} EP('do_15_Option'); {$ENDC} END; { ----- do_15_Option ----- } { ------------------------------------------------------------------------ }  PROCEDUtion'); {$ENDC} WRITE('Perform comment commands (Y/N) [Y] ? '); READLN(s); IF (s = '') THEN g_Options.do_comment_cmds := TRUE ELSE g_Options.do_comment_cmds := (s[1] = 'Y') OR { ----- do_14_Option ----- } { ------------------------------------------------------------------------ } PROCEDURE do_15_Option; { Perform comment commands } BEGIN { ----- do_15_Option ----- } {$IFC fHasDebug} BP('do_15_Op range'); END; END; UNTIL parse_ok OR (s = ''); IF (s <> '') AND parse_ok THEN g_Options.page_width := number; {$IFC fHasDebug} EP('do_14_Option'); {$ENDC} END; nds) ', '[',g_Options.end_delay:1,'] ? '); READLN(s); IF (s <> '') THEN BEGIN number := string_To_Int(s,parse_ok); IF parse_ok THEN parse_ok := (number >= 0) AND (number < 10*30); IF NOT(parse_ok) THEN WRITELN('*** Warning - ', 'Ending delay is invalid or out of range'); ENDF number_lines THEN WRITELN('TRUE') ELSE WRITELN('FALSE'); WRITE(' [ 9] Slashed zeros : '); IF slash_zeros THEN WRITELN('TRUE') [ 7] Paper type : '); IF fanfold_paper THEN WRITELN('Fanfold') ELSE WRITELN('Single sheets'); WRITE(' [ 8] Number lines : '); I {$ENDC} WRITE(' [ 5] Trailer phrase : '); WRITELN('"',trailer_phrase,'"'); WRITE(' [ 6] Font pitch size : '); WRITELN(font_size:1); WRITE(' get_CLOCK_String(date_and_time,numString); WRITELN('[',numString,']'); {$ELSEC} get_CLOCK_String(date_and_time,numString); WRITELN(numString); fs_Italic : WRITELN('Italic'); END; WRITE(' [ 4] Current date : '); {$IFC fHasClock} WRITE('System clock installed '); read_CLOCK(date_and_time); Lowercased'); END; WRITE(' [ 3] Keyword Font style : '); CASE keyw_font_style OF fs_Underline : WRITELN('Underline'); fs_Bold : WRITELN('Bold'); WRITE(' [ 2] Keyword state : '); CASE keyword_state OF kw_Unchanged : WRITELN('Unchanged'); kw_Majuscule : WRITELN('Capitalized'); kw_Minuscule : WRITELN(' BEGIN WRITE(' [ 1] Keywords : '); IF plain_keywords THEN WRITELN('Unhighlighted') ELSE WRITELN('Highlighted'); ------ } BEGIN { ----- handle_Options ----- } {$IFC fHasDebug} BP('handle_Options'); {$ENDC} REPEAT BEGIN WRITELN; WRITELN('Current options:'); WRITELN; WITH g_Options DO OTHERWISE WRITELN('*** Warning - Invalid option number'); END; {$IFC fHasDebug} EP('do_Options'); {$ENDC} END; { ----- do_Options ----- } { ------------------------------------------------------------------ 11 : do_11_Option; 12 : do_12_Option; 13 : do_13_Option; 14 : do_14_Option; 15 : do_15_Option; 16 : do_16_Option; 17 : do_17_Option; 18 : do_18_Option; ion; 3 : do_03_Option; 4 : do_04_Option; 5 : do_05_Option; 6 : do_06_Option; 7 : do_07_Option; 8 : do_08_Option; 9 : do_09_Option; 10 : do_10_Option; ----------------------------------------------------------------------- } BEGIN { ----- do_Options ----- } {$IFC fHasDebug} BP('do_Options'); {$ENDC} CASE option_cmd OF 1 : do_01_Option; 2 : do_02_Opt; END; UNTIL parse_ok OR (s = ''); IF (s <> '') AND parse_ok THEN g_Options.end_delay := number; {$IFC fHasDebug} E('do_18_Option'); {$ENDC} END; { ----- do_18_Option ----- } { - ELSE WRITELN('FALSE'); WRITE(' [10] Italic comments : '); IF (comment_style = fs_Italic) THEN WRITELN('TRUE') ELSE WRITELN('FALSE'); WRITE(' [11] Starting page no. : '); WRITELN(page_start_num:1); WRITE(' [12] Starting line no. : '); WRITELN(line_start_num:1); rectory ELSE BEGIN add_File_Extension(in_file); file_found := file_Exists(in_file); IF NOT(file_found) THEN WRITELN('*** Warni END ELSE BEGIN IF (in_file = '?') THEN { Options } handle_Options ELSE BEGIN IF (in_file = '*') THEN { Disk directory } show_Di user_is_done := FALSE { Not done yet ! } ELSE BEGIN IF (user_answer <> 'Y') AND (user_answer <> 'y') THEN user_is_done := FALSE; { Not done yet ! } END; e = ''); IF user_is_done THEN { Verify user's decision to QUIT } BEGIN WRITE('Are you sure you wish to QUIT (Y/N) [N] ? '); READLN(user_answer); IF (user_answer = '') THEN e file (? = Options, * = Catalog) [',k_Suffix,'] ? '); READLN(in_file); file_found := FALSE; { Assume file does NOT exist } trim_Leading (in_file,' '); trim_Trailing(in_file,' '); user_is_done := (in_filory ----- } { ------------------------------------------------------------------------ } BEGIN { ----- fetch_File_Info ----- } {$IFC fHasDebug} BP('fetch_File_Info'); {$ENDC} REPEAT BEGIN WRITELN; WRITE('Sourc {$ELSEC} { DIRECTORY CATALOG NOT AVAILABLE } sound_BELL; WRITELN('*** NOTE - Directory catalog is NOT currently implemented'); {$ENDC} {$IFC fHasDebug} EP('show_Directory'); {$ENDC} END; { ----- show_Directrectory; { [///] } BEGIN { ----- show_Directory ----- } {$IFC fHasDebug} BP('show_Directory'); {$ENDC} {$IFC fShowCatalog AND fHasClock} { ?????????????????????????????????????????????????????????? } END; END; UNTIL (numString = ''); {$IFC fHasDebug} EP('handle_Options'); {$ENDC} END; { ----- handle_Options ----- } { ------------------------------------------------------------------------ } PROCEDURE show_Di BEGIN WRITELN('*** Warning - Non-numeric string found'); numString := ''; END ELSE do_Options(option_cmd); { Handle the option selection } WRITE('Enter number of the option to change ? '); READLN(numString); IF (numString <> '') THEN BEGIN option_cmd := string_To_Int(numString,conv_ok); IF NOT(conv_ok) THEN delay (.1 sec) : '); WRITELN(page_delay:1); WRITE(' [18] End delay (.1 sec) : '); WRITELN(end_delay:1); END; WRITELN; IF do_comment_cmds THEN WRITELN('TRUE') ELSE WRITELN('FALSE'); WRITE(' [16] Line delay (.1 sec) : '); WRITELN(line_delay:1); WRITE(' [17] Page WRITE(' [13] Page line count : '); WRITELN(page_length:1); WRITE(' [14] Page inch width : '); WRITELN(page_width:1); WRITE(' [15] Do comment commands : '); ng - ', 'Your file was not found; please try again') ELSE BEGIN WRITE('Listing file [',k_Printer,'] ', '[',k_Suffix,'] ? '); READLN(out_file); trim_Leading (out_file,' '); trim_Trailing(out_file,' '); IF (out O^Ű END; { ----- get_CLOCK_String ----- } { <<<<<< END OF FILE : PrettyPrint.1 >>>>>> } keyword file --- Aufwiedersehen ******************************************************************** * Apple /// ChainStuff unit SETCHAIN SETCVAL GETCVAL * Apple /// AppleStuff unit RANDOM RANDOMIZE KEYPRESS JOYSTICK SOUND DATE TIMEOFDAY CLOCKINFO SETTIME PADDLE BUTTON NOTE ******************************************************************** * End of END; END; END; UNTIL file_found OR user_is_done; {$IFC fHasDebug} EP('fetch_File_Info'); {$ENDC} END; { ----- fetch_File_Info ----- } { <<<<<< END OF FILE : PrettyPrint.4 >>>>>> } _file = '') THEN { Default printer } out_file := k_Printer ELSE { Handle extension } add_File_Extension(out_file); END; END;  { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE...: print_File | PURPOSE...: Print the input file to the output file/device | INPUT.....: in_file - Input file name | out_file - Output file name { Setup the relative page line number counter } page_line_counter := k_HTLength - 1; { Remember the header lines } {$IFC fHasDebug} EP('do_Header'); {$ENDC} END; { ----- do_Header ----- } { ---------------------------------- Listing file reference } in_file, { Input file name } prt_summary.alpha_chronos, { Date & time of listing } the_page_counter); { Real page counter } { Bump the various page counters } prt_summary.pages := prt_summary.pages + 1; the_page_counter := the_page_counter + 1; { Print the actual page header lines } print_Header(l_File, {('Please insert the next sheet of paper & press '); READLN(continue); END; { Handle the page delay factor (if needed) } IF (g_Options.page_delay > 0) THEN wait_up(g_Options.page_delay); user for insertion) } IF (prt_summary.pages > 0) AND NOT(g_Options.fanfold_paper) THEN BEGIN sound_BELL; { Make certain user reads this prompt } WRITELN; cp('--- NOTE ---'); cp------------- } PROCEDURE do_Header; VAR continue : CHAR; { Continuation response } BEGIN { ----- do_Header ----- } {$IFC fHasDebug} BP('do_Header'); {$ENDC} { Handle single sheet paper (I.e., prompt comment_exists : BOOLEAN; { Comment active flag } komment_kind : ts_TokenType; { Comment kind } kamment_command : ts_Phrase; { Comment command phrase } { -----------------------------------------------------------ile text line } page_line_counter : INTEGER; { Relative page line count } the_page_counter : INTEGER; { Absolute page counter } the_line_counter : t_BigINTEGER; { Absolute line counter } VAR prt_error : ts_Error); CONST k_HTLength = 4; { Length (in lines) of header & trailer } VAR cancel : BOOLEAN; { User cancellation flag } p_line : ts_Phrase; { An inputted fponse character } dont_care : INTEGER; { Don't care for printer_Controller } { ------------------------------------------------------------------------ } PROCEDURE handle_Printing(VAR prt_summary : t_PrintSummary; p_File : t_TEXT_File; { Inputted Pascal file reference } l_File : t_TEXT_File; { Outputted listing file reference } print_summary : t_PrintSummary; { Printing summary } continue : CHAR; { Continue reses printed } alpha_chronos : t_Clock; { Starting time } omega_chronos : t_Clock; { Ending time } END; VAR : t_Options; 7VAR error : ts_Error); TYPE t_PrintSummary = RECORD { Printing summary information } lines : t_BigINTEGER; { No. lines printed } pages : INTEGER; { No. pag | options - User printing options | OUTPUT....: error - Printing error result |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE print_File( in_file : t_String; ;out_file : t_String; ;options -------------------------------------- } PROCEDURE do_Trailer (the_last_page : BOOLEAN); VAR line_spacer : INTEGER; { Blank line counter } BEGIN { ----- do_Trailer ----- } {$IFC fHasDebug} BP('do_Trailer'); {$ENDC} FOR line_spacer := 1 TO (g_Options.page_length - page_line_counter - k_HTLength - 4) DO printer_Controller(l_F the_word := a_tokin_phrase; print_Word(l_File,the_word,FALSE); END; UNTIL (a_token_kind = tk_STick) OR (a_offset > LENGTH(a_line)); {$IFC fHasDebug} EP('x_Quoted_String_Constant'); {$ENDC} ,FALSE); { Process quote characters until end of quote token found } REPEAT BEGIN a_token_kind := TS_GetToken(a_line,a_offset, a_tokin_phrase); PROCEDURE x_Quoted_String_Constant; BEGIN { ----- x_Quoted_String_Constant ----- } {$IFC fHasDebug} BP('x_Quoted_String_Constant'); {$ENDC} { Print initial quote delimiter } print_Word(l_File,the_wordontroller(l_File,pc_Plain,dont_care); {$IFC fHasDebug} EP('x_Multi_Line_Comment'); {$ENDC} END; { ----- x_Multi_Line_Comment ----- } { ------------------------------------------------------------------------ } L or comment ended } UNTIL (a_offset > LENGTH(a_line)) OR NOT(a_comment_exists); print_Word(l_File,com_phrase,FALSE); { Print the comment phrase } { Always return with the printer font unchanged } printer_Ck_LComment)) THEN BEGIN {Comment terminator found } a_comment_exists := FALSE; { Indicate comment inactive } a_old_comment := tk_SymUNKNOWN; END; END; { Stop on EO { Test for the ending comment token } IF ((a_token_kind = tk_RBrace ) AND (a_old_comment = tk_LBrace )) OR ((a_token_kind = tk_RComment) AND (a_old_comment = t the next line token } a_token_kind := TS_GetToken(a_line,a_offset,a_tokin_phrase); { Store the found token phrase for later use in print_Word } com_phrase := CONCAT(com_phrase,a_tokin_phrase); com_phrase := ''; { Handle italic comment state } IF (g_Options.comment_style = fs_Italic) THEN printer_Controller(l_File,pc_Italic,dont_care); REPEAT BEGIN { FetchFC fHasDebug} BP('x_Multi_Line_Comment'); {$ENDC} { Process each character in the line until either the end } { comment token is found, or until the end of line found } { Initialize the comment phrase to be empty } { ------------------------------------------------------------------------ } PROCEDURE x_Multi_Line_Comment; VAR com_phrase : t_String; { Comment phrase } BEGIN { ----- x_Multi_Line_Comment ----- } {$I VAR a_com_command : ts_Phrase); VAR a_token_kind : ts_TokenType; a_tokin_phrase : ts_Phrase; a_offset : ts_Offset; the_word : t_String; -------------------------------------------------- } PROCEDURE do_Line_Print( a_line : ts_Phrase; VAR a_comment_exists : BOOLEAN; VAR a_old_comment : ts_TokenType; ile,pc_NewLine,dont_care); print_Trailer(the_last_page,l_File); printer_Controller(l_File,pc_FormFeed,dont_care); {$IFC fHasDebug} EP('do_Trailer'); {$ENDC} END; { ----- do_Trailer ----- } { ---------------------- END; { ----- x_Quoted_String_Constant ----- } { ------------------------------------------------------------------------ } PROCEDURE x_Comment; VAR com_phrase : t_String; { Comment phrase } BEGIN { ----- x_Comment ----- } {$IFC fHasDebug} BP('x_Comment'); {$ENDC} { Setup flag information for the found comment } a_comment_exists := TRUE; IF (a_token_kind = tk_LBrace ) OR offset,a_tokin_phrase); { Store the found phrase for later use in print_Word } the_word := a_tokin_phrase; { Test the fetched token's type & handle the cases } IF (a_token_kind = trevious comment line } IF (a_offset <= LENGTH(a_line)) THEN BEGIN REPEAT BEGIN { Fetch a line token } a_token_kind := TS_GetToken(a_line,a_ a_offset := 1; { Start at the 1st character in the line } IF a_comment_exists THEN x_Multi_Line_Comment; { Handle multi-line comment } { Process either the whole line or process the remainder } { of a p} END; { ----- x_Comment ----- } { ------------------------------------------------------------------------ } BEGIN { ----- do_Line_Print ----- } {$IFC fHasDebug} BP('do_Line_Print'); {$ENDC} ND ELSE a_com_command := ''; { Invalid comment command found } END ELSE a_com_command := ''; { Invalid comment command found } {$IFC fHasDebug} EP('x_Comment'); {$ENDCHEN { ^command } BEGIN IF (a_com_command[1] = '^') AND (a_com_command[2] <> ' ') THEN BEGIN DELETE(a_com_command,1,1); { Remove command marker (^) } E printer_Controller(l_File,pc_Plain,dont_care); { Test comment command string for a valid command phrase and } { return formatted comment command phrase to the caller } IF (LENGTH(a_com_command) >= 2) T_phrase); END; UNTIL (a_offset > LENGTH(a_line)) OR NOT(a_comment_exists); print_Word(l_File,com_phrase,FALSE); { Print the comment } { Always return with printer font unaltered } { Concatenate the symbols WITHIN the comment phrase into } { the comment command string } IF a_comment_exists THEN a_com_command := CONCAT(a_com_command,a_tokind = tk_RComment) AND (a_old_comment = tk_LComment)) THEN BEGIN {Comment terminator found } a_comment_exists := FALSE; a_old_comment := tk_SymUNKNOWN; END; com_phrase := CONCAT(com_phrase,a_tokin_phrase); { Test for comment termination } IF ((a_token_kind = tk_RBrace ) AND (a_old_comment = tk_LBrace )) OR ((a_token_kinharacter } a_token_kind := TS_GetToken(a_line,a_offset, a_tokin_phrase); { Store the character for later use in print_Word } { Initialize the comment string } com_phrase := the_word; { Initialize the comment command string to be empty } a_com_command := ''; REPEAT BEGIN { Fetch the next comment c (a_token_kind = tk_LComment) THEN a_old_comment := a_token_kind; { Handle italic comment state } IF (g_Options.comment_style = fs_Italic) THEN printer_Controller(l_File,pc_Italic,dont_care); k_SymUNKNOWN) OR ((a_token_kind > tk_SymSTART ) AND (a_token_kind < tk_SymEND )) THEN BEGIN { Symbol token found } IF (a_token_kind = tk_LBrace (* '{' *)) OR (a_token_kind = tk_LComment { '(*' }) THEN BEGIN x_Comment; { Pascal comment start found } END ELSE BEGIN { Or ??? } { ??? WHERE NO BLANKS EXISTS BETWEEN COMMENT_START & ^COMMAND ??? } { ??? ??? } { ??? AN EXAMPLE IS: (*^FF*) RAL SYNTAX IS AS FOLLOWS: ??? } { ??? ??? } { ??? COMMENT_START ^COMMAND COMMENT_END ??? } { ??? { ??? [5] COMMAND MUST BE THE LAST COMMENT IN A LINE ??? } { ??? [6] ONLY ONE COMMAND PER LINE IS ALLOWED ??? } { ??? ??? } { ??? THE GENE { ??? [2] COMMAND STARTS WITH THE CARET CHARACTER '^' ??? } { ??? [3] COMMAND PHRASE FOLLOWS DIRECTLY AFTER THE CARET ??? } { ??? [4] COMMAND PHRASE CASE IS UNIMPORTANT ??? } INTO A ??? } { ??? COMMENT WHICH FOLLOW SEVERAL RULES: ??? } { ??? ??? } { ??? [1] COMMAND FOLLOWS DIRECTLY AFTER COMMENT START SYMBOL ??? } ??? } { ??? *** NOTE *** ??? } { ??? ??? } { ??? THE COMMENT COMMANDS ARE TEXTUAL COMMANDS PLACED{ ------------------------------------------------------------------------ } PROCEDURE do_Comment_Command(VAR com_cmd : ts_Phrase); { ????????????????????????????????????????????????????????????????? } { ??? END; UNTIL (a_offset > LENGTH(a_line)); { Stop when line processed } END; {$IFC fHasDebug} EP('do_Line_Print'); {$ENDC} END; { ----- do_Line_Print ----- } show_Error ('INVALID TOKEN RETURNED BY TS_GetToken', MAXINT); END; END; END; BEGIN { Print identifier } print_Word(l_File,the_word,FALSE); END ELSE BEGIN { An internal token search unit error } print_Word(l_File,the_word,TRUE); { Print special } END ELSE BEGIN { Test for an identifier } IF (a_token_kind = tk_Identifier) THEN IF ((a_token_kind > tk_SpecSTART) AND (a_token_kind < tk_SpecEND )) OR (a_token_kind = tk_ExtTOKEN ) THEN BEGIN ELSE { Print the ordinary symbol } print_Word(l_File,the_word,FALSE); END; END ELSE { Test for a special (reserved) token } BEGIN dinary symbol found } IF (a_token_kind = tk_STick) THEN BEGIN { Start of quoted string constant found } x_Quoted_String_Constant; END ??? } { ??? ??? } { ??? CURRENTLY ONLY ONE COMMENT COMMAND IS IMPLEMENTED. THIS ??? } { ??? COMMAND IS THE NEW PAGE COMMAND, DENOTED BY THE PHRASE ??? } { ??? 'FF' (MEANING FORM FEED). THIS COMMAND CAUSES A NEW PAGE ??? } { ??? TO START BEGINNING AT THE NEXT LINE. THE COMMENT COMMAND ??? } { ??? LINE IS PRINTED AS NORMAL AND WILL BE THE LAST LINE ON ??? } { ??? THE CURR_File,pc_FontSize ,g_Options.font_size); IF g_Options.slash_zeros THEN printer_Controller(l_File,pc_0Slash ,dont_care) ELSE printer_Controller(l_File,pc_No0Slash,dont_care); { Start the real printing } ind := tk_SymUNKNOWN; { DON'T CARE } kamment_command := ''; { No comment command is present } { Initialize the various printer options } printer_Controller(l_File,pc_Initialize,dont_care ); printer_Controller(l read_CLOCK(prt_summary.alpha_chronos); { Start the print timer } {$ELSEC} prt_summary.alpha_chronos := g_Options.date_and_time; {$ENDC} comment_exists := FALSE; { No comments are currently alive } komment_k } {$IFC fHasDebug} BP('handle_Printing'); {$ENDC} the_page_counter := g_Options.page_start_num - 1; the_line_counter := g_Options.line_start_num - 1; {$IFC fHasClock} the command was processed } {$IFC fHasDebug} EP('do_Comment_Command'); {$ENDC} END; { ----- do_Comment_Command ----- } { ------------------------------------------------------------------------ } BEGIN { ----- handle_Printing ----- *** NOTE *** ??? } { ??? OTHER PROGRAMMER-DEFINED COMMENT COMMAND HANDLERS GO HERE ??? } { ????????????????????????????????????????????????????????????????? } com_cmd := ''; { Signal caller that do_Trailer(FALSE); { Print the current page Trailer ... } do_Header; { ... and the next page Header } END; { ????????????????????????????????????????????????????????????????? } { ??? ('do_Comment_Command'); {$ENDC} the_command := com_cmd; { Always work with capitalized phrases } strUppercase(the_command); { Handle the New Page command [^FF] } IF (the_command = k_NewPageCommand) THEN BEGIN ??????????????????????????????? } CONST k_NewPageCommand = 'FF'; { New Page command phrase } VAR the_command : t_String; { Command string to process } BEGIN { ----- do_Comment_Command ----- } {$IFC fHasDebug} BPAN INVALID COMMENT COMMAND OCCURED AND THE LINE ??? } { ??? NUMBER OF THE OFFENSIVE COMMAND SHOULD BE DISPLAYED. ??? } { ??? ??? } { ?????????????????????????????????? { ??? COMMAND PHRASES. FOR EXAMPLE, IF THE COMMAND IS (*^FG*) ??? } { ??? AND 'FG' IS NOT A DEFINED COMMAND, THEN NOTHING IS DONE. ??? } { ??? THEORETICALLY, A MESSAGE SHOULD BE SENT TO THE USER ??? } { ??? STATING OLE ??? } { ??? MESSAGE TO THE USER (MAYBE THE CURRENT TIME), ETC... ??? } { ??? ??? } { ??? NOTE, THIS ROUTINE CURRENTLY DOES NOT HANDLE ANY INVALID ??? } NED, THIS ROUTINE SHOULD BE ??? } { ??? MODIFIED AS APPROPRIATE TO IMPLEMENT THE COMMAND ACTION. ??? } { ??? POSSIBLE OTHER COMMANDS ARE TO CHANGE KEYWORD HIGHLIGHT ??? } { ??? STYLE, CHANGE/MODIFY THE TRAILER PHRASE, SEND A CONSENT PAGE. ??? } { ??? ??? } { ??? OTHER COMMANDS CAN EASILY BE IMPLEMENTED IF THE ABOVE ??? } { ??? RULES ARE FOLLOWED. ONCE DEFI do_Header; { Print the header for the first page } prt_error := ts_k_NoError; { Assume all is well } { Read an input line, process it, and then print it } REPEAT BEGIN cancel := user_STOP; { Stopping keys pressed ? } IF NOT(cancel) THEN { No, so print away } BEGIN { Read a line from the file } READLN(p_File,p_line); prt_error := IORESULT; sDebug} BP('show_Summary_Information'); {$ENDC} WITH print_summary DO BEGIN { Always inform the user of the page & line statisitcs } WRITELN; WRITELN('Total pages printed = ',pages); WRITEhandle_Printing ----- } { ------------------------------------------------------------------------ } PROCEDURE show_Summary_Information; VAR clk_string : t_String; BEGIN { ----- show_Summary_Information ----- } {$IFC fHa IF (prt_error = ts_k_NoError) THEN do_Trailer(TRUE); { Tidy up the printer before exiting } printer_Controller(l_File,pc_Terminate,dont_care); {$IFC fHasDebug} EP('handle_Printing'); {$ENDC} END; { ----- l; { Handle the case of user cancellation } IF cancel THEN BEGIN WRITELN; cp('*** Printing stopped by user ***'); END; { Print the trailer for the last printed page } mds THEN do_Comment_Command(kamment_command); END; END; END; END; END; UNTIL EOF(p_File) OR (prt_error <> ts_k_NoError) OR canceinter_Controller(l_File,pc_NewLine,dont_care); { Handle a comment command if it exists } IF (kamment_command <> '') THEN BEGIN IF g_Options.do_comment_c { Handle a line delay (if needed) } IF (g_Options.line_delay > 0) THEN wait_up(g_Options.line_delay); { Start a new print line } pr the line & print them } BEGIN { Print the processed line } do_Line_Print(p_line,comment_exists,komment_kind, kamment_command); IF (LENGTH(p_line) = 0) THEN BEGIN { Empty line found (minimal case) } printer_Controller(l_File,pc_NewLine,dont_care); END ELSE { Process the tokens in BEGIN printer_Controller(l_File,pc_Bold ,dont_care); WRITE(l_File,'[',the_line_counter:6,'] '); printer_Controller(l_File,pc_NoBold,dont_care); END; the_line_counter := the_line_counter + 1; { Do the actual line printing } print_Left_Margin(l_File); IF g_Options.number_lines THEN { Print a line number } { ... and the Header } END; { Bump the line counters } prt_summary.lines := prt_summary.lines + 1; page_line_counter := page_line_counter + 1; tire page } IF (page_line_counter = (g_Options.page_length-k_HTLength-4)) THEN BEGIN do_Trailer(FALSE); { Print the Trailer ... } do_Header; IF (prt_error = ts_k_NoError) THEN BEGIN { Remove any control codes in the read line } trim_ControlCodes(p_line); { DTC: 01-May-1988 } { Test for the completion of an enLN('Total lines printed = ',lines); { Inform the user of the printing time (iff clock installed) } {$IFC fHasClock} WRITELN; read_CLOCK(omega_chronos); get_CLOCK_String(alpha_chronos,clk_string); DELETE(clk_string,1,12); WRITELN('Starting clock time = ',clk_string); get_CLOCK_String(omega_chronos,clk_string); DELETE(clk_string,1,12); sDebug} EP('print_File'); {$ENDC} END; { ----- print_File ----- } { <<<<<< END OF FILE : PrettyPrint.5 >>>>>> } show_Error(CONCAT('Closing file "',in_file,'" failed'), error); END; { Show the printing summary report to the user } IF (error = ts_k_NoError) THEN show_Summary_Information; {$IFC fHa show_Error(CONCAT('Closing file "',in_file,'" failed'), error); END; CLOSE(p_File,LOCK); error := IORESULT; { Handle any shop closing errors } IF (error <> ts_k_NoError) THEN _file,'" failed'), error); { Close up the print shop } CLOSE(l_File,LOCK); error := IORESULT; { Handle any shop closing errors } IF (error <> ts_k_NoError) THEN (if needed) } IF (g_Options.end_delay > 0) THEN wait_up(g_Options.end_delay); { Handle any printing errors } IF (error <> ts_k_NoError) THEN show_Error(CONCAT('Printing file "',in READLN(continue); WRITELN; cp(CONCAT('Printing file "',in_file,'" ...')); { Print the entire document } handle_Printing(print_summary,error); { Handle the ending delay cp('* VERIFY THAT THE PRINTER IS ON & PAPER IS INSTALLED *'); cp('******************************************************'); WRITELN; cp('Please press to continue'); use printing, press the

key'); .cp('To Continue printing, press the key'); WRITELN; { Remind the user about the printer & its paper } cp('******************************************************'); NCAT('Opening file "',out_file,'" failed'),error) ELSE BEGIN { Inform the user that s/he may stop the printing } cp('--- NOTE ---'); cp('To Quit printing, press the key'); .cp('To Pa IF (error <> ts_k_NoError) THEN show_Error(CONCAT('Opening file "',in_file,'" failed'),error) ELSE BEGIN REWRITE(l_File,out_file); error := IORESULT; IF (error <> ts_k_NoError) THEN show_Error(CO WRITELN; { Initialize the page & line counters for the print job } print_summary.lines := 0; print_summary.pages := 0; { Open the input and output printing files } RESET(p_File,in_file); error := IORESULT; ---------------------- } BEGIN { ----- print_File ----- } {$IFC fHasDebug} BP('print_File'); {$ENDC} { Tell the user what is happening } WRITELN; cp(CONCAT('Preparing to print file "',in_file,'" to "',out_file,'" ...')); WRITELN('Ending clock time = ',clk_string); {$ENDC} END; {$IFC fHasDebug} EP('show_Summary_Information'); {$ENDC} END; { ----- show_Summary_Information ----- } { --------------------------------------------------Bold,Italic) [Bold] ? צ! ѹ ѲBǶѲצ׷фI;5/BU(  "$&?'-*** Note - Your system has a buille : I Underline;צBold%צItalic P7# [ 4] Current date : צSystem clock installed []צ [ 5] Trailer phrase : ords :  Unhighlightedצ Highlighted [ 2] Keyword state : T UnchangedGצ Capitalized* Lowercased\C( [ 3] Keyword Font sty 6fH%&'()*+,-.~/z0v1r2n3j4f5b6^$OMKIGECA?=;97531/-#*** Warning - Invalid option number $Current options: [ 1] Keywdelay (in 1/10 seconds) [ ] ? ׷~жѡĶ ɄѶѓOצ*** Warning - צ'Ending delay is invalid or out of rangeѲׯצфЫ[ ] ? ׷|жѡĶ ɄѶѓMצ*** Warning - צ%Page delay is invalid or out of rangeѲׯצфЫ  5ѶצEnding ] ? ׷|жѡĶ ɄѶѓMצ*** Warning - צ%Line delay is invalid or out of rangeѲׯצфЫ  4ѶצPage delay (in 1/10 seconds) r out of rangeѲצ׷фЫ2%Perform comment commands (Y/N) [Y] ? צYòyÍn3ѶצLine delay (in 1/10 seconds) [ Ѳצ׷фЫ1ѶצPage line width (in inches) [ צ] ? צzжѡŶ$ɄѶѓM*** Warning - %Page width is invalid oׯצфЫ 0ѶצPage line count [ צ] ? צ|жѡŶDŽɄѶѓM*** Warning - %Line count is invalid or out of range׷фЫ/ѶצStarting line number [ ] ? ׷tжѡ ŸѶѓN*** Warning - &Line number is invalid or out of rangeѲòyÍn.ѶצStarting page number [ ] ? ׷qжѡ ŸѶѓK*** Warning - #Page number invalid or out of rangeѲצצYòyÍf,Slash the zeros (Y/N) [Y] ? ׯYòyÍd-#Italic Pascal comments (Y/N) [Y] ? צY Warning - %Pitch size is invalid or out of rangeѲצ׷фЫ*Fanfold paper (Y/N) [Y] ? ׯYòyÍb+Number each line (Y/N) [Y] ? t-in clock !H(Trailer phrase ? צ%ǭH)ѶצFont pitch size [ צ] ? צzжѡŶ2ɄѶѓM***"%" [ 6] Font pitch size :  צ [ 7] Paper type : צFanfold Single sheetsצ [ 8] Number lines : צTRUEצ