PROGRAM GSigns; {****************************************************************************** ** ** Robert W. Bloom ** ** Function: This program reads input from the terminal and creates signs. ** The sign can be either horizontal or vertical in a number of ** formats. The file CHARS.DAT is used to read the fonts of the ** input characters. ** ** Notes: Chars.Dat is created with MakeFont.Pas from Chars.Asc ** See Signs.DOC for more information ** *****************************************************************************} CONST Date = 'v3.2a, 28 Oct 86'; {last revision of this program} Max_Length = 220; {max number of characters on IDS output line} { approx TRUNC(16.5cpi * 14" line) } Max_Width = 40; {these must match then input file} Max_Height = 24; {and match CONSTs in mf.pas!} Bit_Width = 5; {Max_Width/8} {default problem parameters - TurboPascal Initialized 'Constants'} font_fn : STRING[14] = 'Font1.Dat'; {font filename} sign_type : (sign,banner) = sign; block_type : (letter,block,overstrike) = letter; block_char : CHAR = #88; {'X'} os_strng : STRING[10] = '*XO'; {overstrike string} mult_w : INTEGER = 1; {height multiplier} mult_h : INTEGER = 1; {width multiplier} inter_spc : INTEGER = 1; {space between chars} input_device : (keyboard,text_file) = keyboard; in_fn : STRING[14] = 'Signs.in'; {input filename} num_copies : INTEGER = 1; output_device : (screen,printer,recd_file) = screen; out_fn : STRING[14] = 'Signs.out'; {output filename} prt_cpi : (pica,elite,squeezed,tiny) = squeezed; {chars/inch} prt_lpi : (six,eight,ten,twelve) = twelve; {lines/inch} prt_color : (black,red,green,blue) = black; device_size : (wide,normal) = normal; dumb_prt : BOOLEAN = TRUE; {send codes} inv_video : BOOLEAN = FALSE; given_offset : INTEGER = 0; {left margin} given_width : INTEGER = 0; centering : BOOLEAN = TRUE; font_width : INTEGER = 0; font_height : INTEGER = 0; {size of font in use} TYPE CHARACTER_RECORD = RECORD {record type used for random access} character : CHAR; {the character} width : INTEGER; {how wide is it} height : INTEGER; {how high} pic : ARRAY[1..Max_Height,1..Max_Width] OF CHAR END; {record} {its 'picture'} BIT_RECORD = RECORD {record type used for random access} character : CHAR; width : INTEGER; height : INTEGER; bit_map : ARRAY[1..Max_height,1..Bit_Width] OF BYTE END; {record} OUT_FILE_TYPE = FILE OF BIT_RECORD; FONT_FILE_TYPE = FILE OF BIT_RECORD; SIGN_ARRAY = ARRAY[1..Max_Height,1..Max_Length] OF CHAR; S80 = STRING[80]; {for input} S14 = STRING[14]; {for filenames} S2 = STRING[2]; {for Hex input} VAR font_file : FONT_FILE_TYPE; in_file,out_file : TEXT; {files for input and output} avail_chars : INTEGER; {width of output device} char_rec : CHARACTER_RECORD; {global's easier than passing pointers!} disp : BOOLEAN; {true if should display avail_space} out_line : STRING[Max_Length]; {global pass to/from out_char} {************************* Procedures called *********************************} PROCEDURE main; FORWARD; PROCEDURE inp_hex (VAR add_str : S80); FORWARD; PROCEDURE parm_menu (font_f_open : BOOLEAN); FORWARD; PROCEDURE input_menu; FORWARD; PROCEDURE ask_parm (VAR font_f_open : BOOLEAN); FORWARD; PROCEDURE avail_space; FORWARD; PROCEDURE out_sign (VAR inp_line : S80; VAR overflow_err : BOOLEAN); FORWARD; PROCEDURE out_banner (VAR inp_line : S80); FORWARD; FUNCTION check_sign (inp_line : S80; VAR actual_width : INTEGER; VAR out_array : SIGN_ARRAY) : BOOLEAN; FORWARD; PROCEDURE find_rec (fchr : CHAR); FORWARD; PROCEDURE out_char (ochar : CHAR); FORWARD; PROCEDURE set_up_prt (reset_prt : BOOLEAN); FORWARD; PROCEDURE disp_fs; FORWARD; {**************************** Program Start **********************************} PROCEDURE main; LABEL finis,restrt; VAR ans2,ans : CHAR; {entered char} text_input : S80; {to build line into} hex_string : S80; {hex builder} done,ff_open : BOOLEAN; {flags} i : INTEGER; {loop control} output_err : BOOLEAN; {if can't output correctly} BEGIN done := FALSE; ff_open := FALSE; text_input := ''; parm_menu(ff_open); ask_parm(ff_open); input_menu; WRITE('(^W f/Menu) Entry ->'); WHILE NOT done DO BEGIN restrt: READ(kbd,ans); CASE ans OF ^W : input_menu; ^P : BEGIN {change parameters} ask_parm(ff_open); WRITE('Entry ->',text_input); END; ^D,^C : done := TRUE; {done program} ^A : BEGIN inp_hex(hex_string); text_input := text_input + hex_string; WRITE('Continue input ->',text_input); END; ^L,^F : BEGIN {formfeed to printer} WRITELN; IF output_device = printer THEN BEGIN WRITE(lst,^L); WRITELN('Formfeed sent to printer.') END ELSE WRITELN('Output is not directed to printer!'^G); {end} WRITE('Continue input ->',text_input); END; ^H,#127 : BEGIN {backspace once} IF LENGTH(text_input) > 0 THEN BEGIN DELETE(text_input,LENGTH(text_input),1); WRITE(^H,' ',^H) END END; ^X : BEGIN {cancel line, start over} FOR i := 1 TO LENGTH(text_input) DO WRITE(^H,' ',^H); text_input := '' END; ^M : BEGIN {go ahead, process input line} WRITELN; output_err := FALSE; IF (LENGTH(text_input) = 0) AND (input_device <> text_file) THEN BEGIN WRITE('Do you want to quit? (Y/N) -> '^G); READ(kbd,ans2); WRITELN; IF ans2 IN ['y','Y'] THEN GOTO finis ELSE GOTO restrt END; WRITELN('Mode: Processing'); IF output_device = printer THEN set_up_prt(FALSE); out_line := ''; IF input_device = text_file THEN BEGIN FOR i := 1 TO num_copies DO BEGIN WHILE NOT EOF(in_file) DO BEGIN READLN(in_file,text_input); IF output_device <> screen THEN WRITELN('Reading from file -> ',text_input); IF sign_type = sign THEN out_sign(text_input,output_err) ELSE out_banner(text_input) {end if sign} END; {while not eof} IF output_device = printer THEN WRITE(lst,^L); RESET(in_file) END {for each copy wanted} END ELSE IF sign_type = sign THEN out_sign(text_input,output_err) ELSE out_banner(text_input); {end if sign} {end if input from file} IF (NOT output_err) OR (input_device = text_file) THEN IF output_device = screen THEN BEGIN WRITE('Strike any key to continue ...'); READ(kbd,ans); WRITELN END; {end if err} WRITELN; WRITE('Entry ->',text_input) END {process line} ELSE BEGIN {otherwise put entry into input line} text_input := text_input + ans; WRITE(ans) END END {case} END; {while not done} finis: {all done, close appropriate files} WRITELN; WRITELN(''); IF output_device = printer THEN set_up_prt(TRUE); IF output_device = recd_file THEN CLOSE(out_file); IF ff_open THEN CLOSE(font_file); IF input_device = text_file THEN CLOSE(in_file) END; {PROCEDURE main} PROCEDURE out_banner; {(inp_line : S80)} VAR page_offset,pg_lcv,char_num,width_lcv,height_lcv, space_lcv,mult_w_lcv,mult_h_lcv : INTEGER; ochar : CHAR; BEGIN WRITELN; IF centering THEN page_offset := TRUNC((avail_chars - (font_height * mult_h)) / 2) ELSE page_offset := given_offset; IF (output_device <> screen) OR (input_device = keyboard) THEN BEGIN WRITELN('Actual height of line -> ',(font_height*mult_h):1); WRITELN('Added leading spaces -> ',page_offset:1); WRITELN('Mode: Outputting ') END; IF output_device <> screen THEN BEGIN WRITE('Now outputting character -> '); END; out_char(^D); {start w/blank line} FOR char_num := 1 TO LENGTH(inp_line) DO IF ORD(inp_line[char_num]) >= 32 THEN BEGIN {skip bad input} find_rec(inp_line[char_num]); IF output_device <> screen THEN WRITE(char_rec.character); FOR width_lcv := 1 TO char_rec.width DO FOR mult_w_lcv := 1 TO mult_w DO BEGIN FOR pg_lcv := 1 TO page_offset DO out_char(' '); FOR height_lcv := font_height DOWNTO 1 DO FOR mult_h_lcv := 1 TO mult_h DO BEGIN IF char_rec.pic[height_lcv,width_lcv] <> ' ' THEN ochar := char_rec.character ELSE ochar := ' '; {end if} out_char(ochar) END; {for multiplier horizontally} {end for height} out_char(^D) END; {for multiplier vertically} {end for width} IF char_num <> LENGTH(inp_line) THEN FOR space_lcv := 1 TO inter_spc DO out_char(^D) END; {if char is in proper print range} {end for each input char} out_char(^D); {end w/blank line} inp_line := ''; {zero input} END; {PROCEDURE out_banner} PROCEDURE out_sign; {(VAR inp_line : S80; VAR overflow_err : BOOLEAN)} VAR page_offset,pg_lcv,width_lcv,height_lcv,mult_h_lcv, line_width : INTEGER; out_array : SIGN_ARRAY; {'Sign' output line is built into this} BEGIN WRITELN; overflow_err := check_sign(inp_line,line_width,out_array); IF (NOT overflow_err) OR (input_device = text_file) THEN BEGIN IF centering THEN page_offset := TRUNC((avail_chars - line_width) / 2) ELSE IF overflow_err THEN page_offset := 0 ELSE page_offset := given_offset; {end if centering} IF (output_device <> screen) OR (input_device = keyboard) THEN BEGIN WRITELN('Actual width of line -> ',line_width:1); WRITELN('Added leading spaces -> ',page_offset:1); WRITELN('Mode: Outputting ') END; out_char(^D); {start with a blank line} FOR height_lcv := 1 TO font_height DO {output line} FOR mult_h_lcv := 1 TO mult_h DO BEGIN FOR pg_lcv := 1 TO page_offset DO out_char(' '); FOR width_lcv := 1 TO line_width DO out_char(out_array[height_lcv,width_lcv]); {end for width} out_char(^D) END; {for height multiplier} {end for height} out_char(^D); {end w/blank line} inp_line := '' {zero input} END ELSE WRITELN('Input line is too long!'^G); END; {PROCEDURE out_sign} FUNCTION check_sign; {(inp_line : S80; VAR actual_width : INTEGER) : BOOLEAN} LABEL done; VAR height_lcv,width_lcv,mult_w_lcv,char_num : INTEGER; err : BOOLEAN; ochar : CHAR; BEGIN err := FALSE; FOR height_lcv := 1 to font_height DO FOR width_lcv :=1 TO avail_chars DO out_array[height_lcv,width_lcv] := ' '; {initialize line array} IF (output_device <> screen) OR (input_device = keyboard) THEN BEGIN WRITE('Now processing character -> '); END; actual_width := 0; FOR char_num := 1 TO LENGTH(inp_line) DO {build line} IF ORD(inp_line[char_num]) >= 32 THEN BEGIN {skip bad input} find_rec(inp_line[char_num]); IF (output_device <> screen) OR (input_device = keyboard) THEN WRITE(char_rec.character); IF ((actual_width+(char_rec.width*mult_w)) > avail_chars) THEN BEGIN IF input_device <> text_file THEN WRITELN('<- overflow!'^G); err := TRUE; GOTO done END; {if overflow} FOR width_lcv := 1 TO char_rec.width DO FOR mult_w_lcv := 1 TO mult_w DO BEGIN actual_width := actual_width + 1; FOR height_lcv := 1 TO char_rec.height DO BEGIN IF char_rec.pic[height_lcv,width_lcv] <> ' ' THEN ochar := char_rec.character ELSE ochar := ' '; {end if} out_array[height_lcv,actual_width] := ochar END; {for height} END; {for width multiplier} {end for width of char} IF char_num <> LENGTH(inp_line) THEN actual_width := actual_width + inter_spc {space between chars} END; {if char in in printing range} {end for each input char} IF given_offset <> 0 THEN BEGIN IF ((actual_width + given_offset) > avail_chars) AND NOT ((output_device <> screen) OR (input_device = keyboard)) THEN BEGIN WRITELN('<- Overflow (+offset)!'^G); err := TRUE END {if the given offset overflows} END; {if given the offset, check for overflow} done: WRITELN; check_sign := err END; {PROCEDURE check_sign} PROCEDURE input_menu; BEGIN WRITELN; WRITELN('Mode: Input Text '); WRITELN(' ^P: Change parameters ^F,^L: Send Formfeed to LST ^X: Restart'); WRITELN('^C,^D: Done, quit to OS ^R,^T: Send Reverse Formfeed ^H: Backspace'); WRITELN(': Process Input ^A: Alternate Input (HEX) ^W: Redisplay menu'); END; PROCEDURE inp_hex; {VAR add_str : S80} VAR str : S14; num,err : INTEGER; BEGIN WRITELN; add_str := ''; WRITE('Enter HEX number ->'); READLN(str); WHILE str <> '' DO BEGIN VAL('$'+str,num,err); IF (err <> 0) OR (num < 20) OR (num > 255) THEN BEGIN WRITELN('Invalid!'^G); END ELSE BEGIN WRITELN('adding char #',num); add_str := add_str + CHR(num) END; WRITE('Enter HEX number ->'); READLN(str) END; {while something entered} END; PROCEDURE find_rec; { (fchr : CHAR); } VAR rec_number : INTEGER; rec : BIT_RECORD; i,j,count : INTEGER; BEGIN rec_number := ORD(fchr) - 32; SEEK(font_file,rec_number); READ(font_file,rec); FOR i := 1 TO font_height DO FOR j := 1 TO font_width DO char_rec.pic[i,j] := ' '; {zero transfer record} char_rec.character := rec.character; char_rec.width := rec.width; char_rec.height := rec.height; FOR i := 1 TO Max_Height DO FOR j := 1 TO Bit_Width DO BEGIN count := rec.bit_map[i,j]; IF count >= 128 THEN BEGIN char_rec.pic[i,8*j] := 'X'; count := count - 128 END; IF count >= 64 THEN BEGIN char_rec.pic[i,8*j-1] := 'X'; count := count - 64 END; IF count >= 32 THEN BEGIN char_rec.pic[i,8*j-2] := 'X'; count := count - 32 END; IF count >= 16 THEN BEGIN char_rec.pic[i,8*j-3] := 'X'; count := count - 16 END; IF count >= 8 THEN BEGIN char_rec.pic[i,8*j-4] := 'X'; count := count - 8 END; IF count >= 4 THEN BEGIN char_rec.pic[i,8*j-5] := 'X'; count := count - 4 END; IF count >= 2 THEN BEGIN char_rec.pic[i,8*j-6] := 'X'; count := count - 2 END; IF count >= 1 THEN char_rec.pic[i,8*j-7] := 'X'; END {end for} END; PROCEDURE out_char; { (ochar : CHAR) } VAR i,given_length,os_lcv,strikes : INTEGER; find_char : CHAR; PROCEDURE putchr(chr:CHAR); BEGIN CASE output_device OF printer : WRITE(lst,chr); recd_file : WRITE(out_file,chr); screen : WRITE(con,chr) END; {case} END; {subprocedure putchr} BEGIN IF ochar <> ^D THEN {add char to out_line} out_line := out_line + ochar ELSE BEGIN {output out_line} given_length := LENGTH(out_line); IF inv_video THEN BEGIN find_char := ' '; i := 1; WHILE (find_char = ' ') AND (i <= given_length) DO BEGIN IF out_line[i] <> ' ' THEN find_char := out_line[i]; i := i + 1 END; {while} IF find_char = ' ' THEN find_char := block_char; FOR i := 1 TO given_length DO IF out_line[i] = ' ' THEN out_line[i] := find_char ELSE out_line[i] := ' '; FOR i := (given_length + 1) TO (avail_chars - 1) DO out_line := out_line + find_char; given_length := LENGTH(out_line) END; {if inv-video} IF block_type = block THEN FOR i := 1 TO given_length DO IF out_line[i] <> ' ' THEN out_line[i] := block_char; IF block_type = overstrike THEN {multiple hits?} strikes := LENGTH(Os_Strng) ELSE strikes := 1; FOR os_lcv := 1 TO strikes DO BEGIN FOR i := 1 TO given_length DO IF (block_type = overstrike) AND (out_line[i] <> ' ') THEN putchr(Os_Strng[os_lcv]) ELSE putchr(out_line[i]); {for each char in out_line} putchr(^M) END; {for overstrikes} putchr(^J); out_line := '' {zero input} END {if eol} END; {procedure out_char} PROCEDURE set_up_prt; { (reset_prt : BOOLEAN) } BEGIN IF NOT dumb_prt THEN BEGIN WRITE(lst,CHR(27),'R2$'); {Draft quality print} IF reset_prt THEN BEGIN WRITE(lst,CHR(30)); {12 cpi} WRITE(lst,CHR(27),'B8$'); {6 lpi} WRITE(lst,CHR(27),'Q4$') {Black} END ELSE BEGIN CASE prt_lpi OF six : WRITE(lst,CHR(27),'B8$'); eight : WRITE(lst,CHR(27),'B6$'); twelve : WRITE(lst,CHR(27),'B4$'); ten : WRITE(lst,CHR(27),'B5$') END; {case} CASE prt_cpi OF pica : WRITE(lst,CHR(29)); squeezed : WRITE(lst,CHR(31)); elite : WRITE(lst,CHR(30)); tiny : WRITE(lst,CHR(30)) {20 cpi n/a on Prism, use 16.7} END; {case} CASE prt_color OF black : WRITE(lst,CHR(27),'Q4$'); blue : WRITE(lst,CHR(27),'Q3$'); green : WRITE(lst,CHR(27),'Q2$'); red : WRITE(lst,CHR(27),'Q1$'); END {case} END END END; PROCEDURE avail_space; LABEL skip; VAR pitch : REAL; BEGIN IF NOT disp THEN GOTO skip; {return w/o doing anything} IF given_width = 0 THEN BEGIN IF output_device = printer THEN BEGIN CASE prt_cpi OF pica : pitch := 10; elite : pitch := 12; squeezed : pitch := 16.5; {use 17 for Epson} tiny : pitch := 20; {n/a on IDS printer} END; {case} IF device_size = wide THEN avail_chars := TRUNC(pitch * 14) ELSE avail_chars := TRUNC(pitch * 8) END ELSE {output_device = screen or recd_file} IF device_size = wide THEN avail_chars := 132 ELSE avail_chars := 80; {end if} END ELSE {width WAS given} avail_chars := given_width; {end if width was not given} WRITELN('Calculated width available -> ',avail_chars); IF font_height <> 0 THEN BEGIN IF sign_type = sign THEN BEGIN {est based on 8+1 spaces/char} WRITELN('Approx # of *input* chars allowed -> ', ROUND(avail_chars/(mult_w*(font_width+inter_spc-2)))); END ELSE BEGIN WRITELN('Output line must be at least -> ', (font_height * mult_h) + given_offset); IF ((font_height * mult_h) + given_offset) > avail_chars THEN WRITELN('Error: Output overflow!'^G) {if overflow} END {if sign output approx max input line} END; skip: END; PROCEDURE disp_fs; BEGIN WRITELN('Font width: ',font_width,' Height: ',font_height) END; {procedure disp_fs} PROCEDURE disp_f; BEGIN WRITELN('F- Font File -> ',Font_Fn) END; {procedure disp_f} PROCEDURE disp_t; BEGIN WRITE('T- Sign type -> '); IF sign_type = sign THEN WRITELN('Sign ') ELSE WRITELN('Banner'); avail_space END; {procedure disp_t} PROCEDURE disp_b; BEGIN WRITE('B- Block/Letter type -> '); CASE block_type OF letter : WRITELN('Letters '); block : WRITELN('Bk Char #',ORD(block_char):3); overstrike : WRITELN('OverStrikeBk') END {case} END; {procedure disp_b} PROCEDURE disp_w; BEGIN WRITELN('W- Width Multiplier -> ',mult_w); IF sign_type = sign THEN avail_space END; {procedure disp_w} PROCEDURE disp_h; BEGIN WRITELN('H- Height Multiplier -> ',mult_h); IF sign_type = banner THEN avail_space END; {procedure disp_h} PROCEDURE disp_c; BEGIN IF (output_device = printer) AND NOT dumb_prt THEN BEGIN WRITE('C- Color of Print -> '); CASE prt_color OF black : WRITELN('Black'); red : WRITELN('Red '); green : WRITELN('Green'); blue : WRITELN('Blue ') END {case} END ELSE END; {procedure disp_c} PROCEDURE disp_a; BEGIN IF given_offset = 0 THEN BEGIN WRITE('A- Auto-Centering -> '); IF centering THEN WRITELN('Yes') ELSE WRITELN('No ') END ELSE BEGIN disp_c END END; {procedure disp_a} PROCEDURE disp_m; BEGIN WRITE('M- Given left margin -> '); IF given_offset = 0 THEN WRITELN('none defined') ELSE WRITELN(given_offset,' '); disp_a END; {procedure disp_m} PROCEDURE disp_s; BEGIN IF given_width = 0 THEN BEGIN WRITE('S- Device Size -> '); IF device_size = normal THEN WRITELN('Normal') ELSE WRITELN('Wide ') END ELSE avail_space END; {procedure disp_s} PROCEDURE disp_g; BEGIN WRITE('G- Given Width -> '); IF given_width = 0 THEN WRITELN('not given') ELSE WRITELN(given_width); disp_s; avail_space END; {procedure disp_g} PROCEDURE disp_v; BEGIN WRITE('V- Inverse Video -> '); IF inv_video THEN WRITELN('On, Inverse') ELSE WRITELN('Off, Normal') END; {procedure disp_v} PROCEDURE disp_x; BEGIN WRITELN('X,- eXit Change Parm') END; {procedure disp_x} PROCEDURE disp_y; BEGIN WRITELN('Y- Inter-Char Space -> ',inter_spc); avail_space END; {procedure disp_y} PROCEDURE disp_r; BEGIN IF input_device = text_file THEN WRITELN('R- FileName to Read -> ',in_fn) END; {procedure disp_r} PROCEDURE disp_n; BEGIN IF input_device = text_file THEN WRITELN('N- Number of Copies -> ',num_copies) END; {procedure disp_n} PROCEDURE disp_e; BEGIN IF output_device = recd_file THEN WRITELN('E- rEcord Output in -> ',out_fn); END; {procedure disp_e} PROCEDURE disp_i; BEGIN WRITE('I- Input Device -> '); IF input_device = keyboard THEN WRITELN('Keyboard') ELSE WRITELN('File '); {END if} disp_r; disp_n END; {procedure disp_i} PROCEDURE disp_p; BEGIN IF (output_device = printer) AND NOT dumb_prt THEN BEGIN WRITE('P- Pitch chars/inch -> '); CASE prt_cpi OF pica : WRITELN('Pica [10] '); elite : WRITELN('Elite [12] '); squeezed : WRITELN('Squeezed [16.5]'); tiny : WRITELN('Tiny [20] ') END {case} END; avail_space END; {procedure disp_p} PROCEDURE disp_l; BEGIN IF (output_device = printer) AND NOT dumb_prt THEN BEGIN WRITE('L- Lines/Inch -> '); CASE prt_lpi OF six : WRITELN('Six '); eight : WRITELN('Eight '); ten : WRITELN('Ten '); twelve : WRITELN('Twelve') END {case} END; avail_space END; {procedure disp_l} PROCEDURE disp_d; BEGIN WRITE('D- Dumb Printer Flag -> '); IF dumb_prt THEN WRITELN('On (Dumb Prt) ') ELSE WRITELN('Off (Smart Prt)'); disp_p; disp_l; disp_c; END; {procedure disp_d} PROCEDURE disp_o; BEGIN WRITE('O- Output device -> '); CASE output_device OF screen : WRITELN('Screen '); recd_file : BEGIN WRITELN('File '); disp_e; END; printer : BEGIN WRITELN('Printer'); disp_d; END; END; {case} avail_space END; {procedure disp} PROCEDURE disp_q; BEGIN WRITELN('Q- Quit and Return back to OS'); END; {procedure disp_q} PROCEDURE ask_x(VAR done,font_f_open,out_f_open : BOOLEAN; old_ff,old_of : S14); {f/exiting to input} VAR err : INTEGER; bit_rec : BIT_RECORD; BEGIN IF (sign = Banner) AND (((font_height * mult_h) + given_offset) > avail_chars) THEN BEGIN done := FALSE; WRITELN('Banner is too big to fit on output!'^G) END ELSE BEGIN {is banner height ok?} done := TRUE; IF out_f_open AND (output_device <> recd_file) THEN BEGIN {$I-} CLOSE(out_file); {$I+} {close old file} err := IORESULT; IF err <> 0 THEN BEGIN out_fn := '????'; WRITELN('ERR:',err,' closing record file, check it!'^G); done := FALSE END END; {if no more file output} IF NOT out_f_open AND (output_device = recd_file) THEN BEGIN ASSIGN(out_file,out_fn); {start file output} {$I-} REWRITE(out_file); {$i+} err := IORESULT; IF err <> 0 THEN BEGIN out_fn := '????'; WRITELN('ERR:',err,' opening record file, check it!'^G); disp_e; done := FALSE END ELSE out_f_open := TRUE; END; {if new file output} IF out_f_open AND (output_device = recd_file) AND (out_fn <> old_of) THEN BEGIN {change output file} {$I-} CLOSE(out_file); {$I+} {close old file} err := IORESULT; IF err <> 0 THEN BEGIN out_fn := '????'; WRITELN('ERR:',err,' closing old record file, check it!'^G); done := FALSE END; ASSIGN(out_file,out_fn); {$I-} REWRITE(out_file); {$I+} {open new file} err := IORESULT; IF err <> 0 THEN BEGIN out_fn := '????'; WRITELN('ERR:',err,' opening new record file, check it!'^G); disp_e; done := FALSE END END; {if file output was changed} IF (old_ff <> font_fn) OR NOT font_f_open THEN BEGIN ASSIGN(font_file,font_fn); {$I-} RESET(font_file); {$I+} err := IORESULT; IF err <> 0 THEN BEGIN font_fn := '????'; WRITELN('ERR:',err,' opening Font file, check it!'^G); disp_f; done := FALSE END ELSE BEGIN font_f_open := TRUE; SEEK(font_file,95); READ(font_file,bit_rec); font_width := bit_rec.width; font_height := bit_rec.height; disp_fs; avail_space END {end if bad open} END; {if font filename was changed} IF input_device = text_file THEN BEGIN ASSIGN(in_file,in_fn); {$I-} RESET(in_file); {$I+} err := IORESULT; IF err <> 0 THEN BEGIN in_fn := '????'; WRITELN('ERR:',err,' opening Input file, check it!'^G); done := FALSE END {if bad open} END {if input from file} END END; {procedure ask_x} PROCEDURE ask_f; {f/font file} VAR strng_ans : STRING[14]; {used for filename input} BEGIN WRITELN('The font file contains the definitions for all characters'); WRITELN('It is created with ''MAKEFONT'' from a ASCII file.'); WRITE('Enter FileName of Font File -> '); READLN(strng_ans); IF strng_ans <> '' THEN font_fn := strng_ans; disp_f END; {procedure ask_f} PROCEDURE ask_t; {f/sign format} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('One can change to type of sign to format the output horizontally'); WRITELN('across page (sign) or vertically down page (banner). Do you want'); WRITE('a Sign or Banner? (S/B) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'B','b' : sign_type := banner; 'S','s' : sign_type := sign END; {case} disp_t; avail_space END; {procedure ask_t} PROCEDURE ask_b; {f/block type} VAR char_ans : CHAR; {used for single char inut} siz_ans : STRING[3]; {used for number input} num,err : INTEGER; BEGIN WRITELN('The graphic characters may be made of the letter of the character'); WRITELN('itself, or two different type of blocks. Do you want to print'); WRITE('Single-strike Blocks, Overstrike blocks, or Letters? (S/O/L) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'S','s' : BEGIN block_type := block; WRITE('Enter Hex code of character to use ->'); READLN(siz_ans); IF siz_ans <> '' THEN BEGIN VAL('$'+siz_ans,num,err); block_char := CHR(num) END END; 'L','l' : block_type := letter; 'O','o' : block_type := overstrike END; {case} disp_b END; {procedure_ask_b} PROCEDURE ask_w; {f/width multiplier} VAR err : INTEGER; {err code from strng-to-num convert} siz_ans : STRING[3]; {used for number input} BEGIN WRITELN('One can make the letters of the sign or banner bigger in width'); WRITELN('by entering a multiplier. 2 doubles size, 3 triples, etc.'); WRITE('Enter multiplier for width -> '); READLN(siz_ans); IF siz_ans <> '' THEN VAL(siz_ans,mult_w,err); disp_w END; {procedure ask_w} PROCEDURE ask_h; {f/height multiplier} VAR err : INTEGER; {err code from strng-to-num convert} siz_ans : STRING[3]; {used for number input} BEGIN WRITELN('One can make the letters of the sign or banner bigger in height'); WRITELN('by entering a multiplier. 2 doubles size, 3 triples, etc.'); WRITE('Enter multiplier for height -> '); READLN(siz_ans); IF siz_ans <> '' THEN VAL(siz_ans,mult_h,err); disp_h END; {procedure ask_h} PROCEDURE ask_g; {f/given device size} VAR err : INTEGER; {err code from strng-to-num convert} siz_ans : STRING[3]; {used for number input} BEGIN WRITELN('If this option is non-zero it will override any of the other'); WRITELN('output size commands. One can enter a defined output device'); WRITE('size (max=',Max_Length,') which will be used for checks and centering -> '); READLN(siz_ans); IF siz_ans <> '' THEN VAL(siz_ans,given_width,err); disp_g END; {procedure ask_g} PROCEDURE ask_m; {f/given left margin} VAR err : INTEGER; {err code from strng-to-num convert} siz_ans : STRING[3]; {used for number input} BEGIN WRITELN('One can enter a given left margin to position banners and signs'); WRITELN('on the paper. If the given left margin is zero, automatic centering'); WRITE('can also be done. Enter number for left margin -> '); READLN(siz_ans); IF siz_ans <> '' THEN BEGIN VAL(siz_ans,given_offset,err); centering := FALSE END; disp_m END; {procedure ask_m} PROCEDURE ask_a; {f/auto-centering} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('This option is active only if the given left margin is zero.'); WRITELN('Output can be centered within the maximum output width.'); WRITE('Should output be automatically centered? (Y/N) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'N','n' : centering := FALSE; 'Y','y' : centering := TRUE END; {case} disp_a END; {procedure ask_a} PROCEDURE ask_v; {f/inverse video} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('This option reverses spaces to characters and vice-versa, effectively'); WRITELN('changing the output to reverse video. The Background is X''s or blocks.'); WRITE('Do you want Reverse Video output? (Y/N) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'N','n' : inv_video := FALSE; 'Y','y' : inv_video := TRUE END; {case} disp_v END; {procedure ask_v} PROCEDURE ask_y; {f/given device size} VAR err : INTEGER; {err code from strng-to-num convert} char_ans : CHAR; {used for single char input} BEGIN WRITELN('The spacing between the characters output may be varied'); WRITE('from 0 to 9. (1 is normal.) Please enter spacing desired -> '); READ(kbd,char_ans); WRITELN; IF char_ans <> '' THEN VAL(char_ans,inter_spc,err); disp_y END; {procedure ask_g,y} PROCEDURE ask_i; {f/input device} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('Input can come from the keyboard in which is is entered one line'); WRITELN('at a time or in a bunch from a external file. Do you want to read'); WRITE('input from the Keyboard or File? (K/F) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'F','f' : input_device := text_file; 'K','k' : input_device := keyboard END; {case} disp_i END; {procedure ask_i} PROCEDURE ask_r; {f/text input file} VAR strng_ans : STRING[14]; {used for filename input} BEGIN WRITELN('This entry is only active if input is read from a file.'); WRITELN('Enter filename of the text file to read that contains the'); WRITE('line(s) to be output -> '); READLN(strng_ans); IF strng_ans <> '' THEN in_fn := strng_ans; disp_r END; {procedure ask_r} PROCEDURE ask_n; {f/number of copies} VAR err : INTEGER; char_ans : CHAR; {used for single char inut} BEGIN WRITELN('This entry is only active if input is from a file.'); WRITELN('Multiple copies are separated by formfeeds.'); WRITE('How many copies do you want? -> '); READ(kbd,char_ans); WRITELN; IF char_ans <> '' THEN VAL(char_ans,num_copies,err); disp_n END; {procedure ask_n} PROCEDURE ask_o; {f/output device} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('Output may be directed to the console screen, a file or the'); WRITELN('printer. (File output may be up to ',Max_Length,' wide.) Do you'); WRITE('want to output to a File, Screen or Printer? (S/F/P) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'P','p' : output_device := printer; 'S','s' : output_device := screen; 'F','f' : output_device := recd_file END; {case} disp_o END; {procedure ask_o} PROCEDURE ask_s; {f/device size} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('Enter (N) if the output device is either an 8" wide printer or'); WRITELN('80 char CRT; or (W) if it is a 14" printer or 132 char screen.'); WRITE('Is output device size Normal or Wide? (N/W) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'W','w' : device_size := wide; 'N','n' : device_size := normal END; {case} disp_s END; {procedure ask_s} PROCEDURE ask_e; {f/record file} VAR strng_ans : STRING[14]; {used for filename input} BEGIN WRITELN('This entry is only active if output is to be recorded in'); WRITE('a file. Enter filename to record output into -> '); READLN(strng_ans); IF strng_ans <> '' THEN out_fn := strng_ans; disp_e END; {procedure ask_e} PROCEDURE ask_p; {f/pitch} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('This entry is active only if outputting to the printer. It controls'); WRITELN('character spacing or pitch: Enter (P)ica for 10 cpi, (E)lite for'); WRITE('12 cpi, (S)queezed for 16.5 cpi, (T)iny for 20 cpi? (P/E/S/T?) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'P','p' : prt_cpi := pica; 'E','e' : prt_cpi := elite; 'S','s' : prt_cpi := squeezed; 'T','t' : prt_cpi := tiny END; {case} disp_p END; {procedure ask_p} PROCEDURE ask_l; {f/line per inch} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('This entry is active only if outputting to the printer.'); WRITELN('This controls line spacing: Enter (S) for 6 lpi,'); WRITE('(E)ight for 8 lpi, (T)en, or tWelve lpi? (S/E/T/W) -> '); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'S','s' : prt_lpi := six; 'E','e' : prt_lpi := eight; 'T','t' : prt_lpi := ten; 'W','w' : prt_lpi := twelve END; {case} disp_l; END; {procedure ask_l} PROCEDURE ask_c; {f/color} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('This entry is active only if outputting to the printer.'); WRITELN('Printer can print in (R)ed, (G)reen, b(L)ue or (B)lack.'); WRITE('Enter color desired? (R/G/L/B) ->'); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'B','B' : prt_color := black; 'R','r' : prt_color := red; 'G','g' : prt_color := green; 'L','l' : prt_color := blue END; {case} disp_c END; {procedure ask_c} PROCEDURE ask_d; {f/color} VAR char_ans : CHAR; {used for single char inut} BEGIN WRITELN('This entry is active only if outputting to the printer. Answer yes if'); WRITELN('the printer is dumb and can''t respond to the built-in formating codes'); WRITE('or the codes are not matched to it (Y/N) ->'); READ(kbd,char_ans); WRITELN; CASE char_ans OF 'Y','y' : dumb_prt := TRUE; 'N','n' : dumb_prt := FALSE END; {case} disp_d END; {procedure ask_d} PROCEDURE ask_q; {f/abort exit} VAR ans : CHAR; BEGIN WRITE('Do you want to abort ''SIGNS'' and quit? (Y/N) -> '^G); READ(kbd,ans); WRITELN; IF ans IN ['y','Y'] THEN BEGIN WRITELN('aborting SIGNS ...'); HALT END END; {procedure ask_q} PROCEDURE parm_menu; {font_f_open : BOOLEAN} BEGIN WRITELN('Options and I/O Parameters'); IF font_f_open THEN disp_fs; disp := FALSE; disp_f; disp_t; disp_b; disp_w; disp_h; disp_m; disp_g; disp_v; disp_y; disp_i; disp_o; disp_q; disp_x; disp := TRUE; avail_space END; {Procedure parm_menu} PROCEDURE ask_parm; { (VAR font_f_open : BOOLEAN) } VAR ans : CHAR; {used for single char inut} done,out_f_open : BOOLEAN; {flags} old_ff,old_of : STRING[14]; {old filenames upon input or procedure} BEGIN WRITELN('Mode: Change Parms'); IF output_device = recd_file THEN out_f_open := TRUE ELSE out_f_open := FALSE; old_of := out_fn; old_ff := font_fn; done := FALSE; WHILE NOT done DO BEGIN WRITE('Enter option letter -> '); READ(kbd,ans); WRITELN; CASE ans OF '?' : parm_menu(font_f_open); ^M,'x','X' : ask_x(done,font_f_open,out_f_open,old_ff,old_of); {check if done and if so, return to input} 'F','f' : ask_f; {change font filename} 'T','t' : ask_t; {change sign type} 'B','b' : ask_b; {change block/letter type} 'W','w' : ask_w; {change width of output graphic characters} 'H','h' : ask_h; {change height of output graphic characters} 'M','m' : ask_m; {enter a given left margin to use} 'A','a' : ask_a; {change auto-centering on/off} 'V','v' : ask_v; {change inverse video on/off} 'Y','y' : ask_y; {change intercharacter spacing} 'G','g' : ask_g; {change the maximum width of output line in characters} 'I','i' : ask_i; {change input device} 'R','r' : ask_r; {change read from input filename} 'N','n' : ask_n; {change number of copyies desired} 'O','o' : ask_o; {change output device} 'E','e' : ask_e; {change output record filename} 'S','s' : ask_s; {change output device size} 'P','p' : ask_p; {change printer characters/inch} 'L','l' : ask_l; {change printer lines/inch} 'C','c' : ask_c; {change printer color} 'D','d' : ask_d; {change dumb printer on/off} 'Q','q' : ask_q; {abort exit} ELSE BEGIN {not a menu option} WRITELN('Unrecognized code ->',ans,'<- ''?'' for menu.'^G); END END; {case} WRITELN; END; {while not done} END; {procedure ask_parm} BEGIN WRITELN('GSigns, Version: ',Date); WRITELN; main; WRITELN('<<< GSigns completed >>>') END.