PROGRAM MakeFont; {****************************************************************************** ** ** Author: Robert W. Bloom ** ** Function: This program reads input from the file 'CHARS.ASC' and creates ** a file 'CHARS.DAT.' CHARS.DAT is used by the program 'SIGNS' ** to create signs or banners. See Signs.DOC for more info. ** *****************************************************************************} CONST Date = 'v2.3, 27 Oct 86'; {date of last revision of this prog} Input_DFN = 'Font'; {default input file} Output_DFN = 'Font'; {default output file} Max_Width = 40; {these must be no greater then input file} Max_Height = 24; {and match CONSTs in signs.pas!} Bit_Width = 5; {Max_Width/8} TYPE CHAR_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} IN_FILE_TYPE = TEXT; OUT_FILE_TYPE = FILE OF CHAR_RECORD; LABEL restart; {for error recovery} VAR c : CHAR; ans,ifn,ofn : STRING[14]; input_fn : IN_FILE_TYPE; output_fn : OUT_FILE_TYPE; trans_chr : CHAR_RECORD; i,j,count,err : INTEGER; max_f_h,max_f_w : INTEGER; pic : ARRAY[1..Max_Height,1..Max_Width] OF CHAR; bit_tot : BYTE; BEGIN WRITELN('<<< MakeFont ',Date,' >>>'); WRITELN; restart: WRITELN('Filenames starting with an ''X'' will terminate program.'); WRITELN('Maximum size of font that can be read is ',Max_Height, ' high and ',Max_Width,' wide.'); WRITELN('Size of the output records will be ',Max_Height,' by ',Bit_Width); WRITELN; WRITELN('If not specified, an extension of .ASC will be assumed.'); WRITE('Enter filename of input file, for the default ''', Input_DFN,''' -->'); READLN(ans); IF ans = '' THEN ifn := Input_DFN ELSE ifn := ans; IF ans[1] IN ['X','x'] THEN HALT; i := POS('.',ifn); IF i = 0 THEN ifn := ifn + '.ASC'; {add extension if not given} WRITELN; WRITELN('If not specified, an extension of .DAT will be assumed.'); WRITE('Enter filename of output file, for the default ''', Output_DFN,''' -->'); READLN(ans); IF ans = '' THEN ofn := Output_DFN ELSE ofn := ans; IF ans[1] IN ['X','x'] THEN HALT; i := POS('.',ofn); IF i = 0 THEN ofn := ofn + '.DAT'; {add extension if not given} ASSIGN(input_fn,ifn); {$I-} RESET(input_fn); {$I+} err := IORESULT; IF err <> 0 THEN BEGIN WRITELN('ERR:',err,' Problem opening input file!'^G); GOTO restart END; ASSIGN(output_fn,ofn); {$I-} REWRITE(output_fn); {$I+} err := IORESULT; IF err <> 0 THEN BEGIN WRITELN('ERR:',err,' Problem in opening output file - try a different name!'^G); GOTO restart END; WRITELN; WRITE('Date of font file --> '); FOR i := 1 TO 10 DO BEGIN READ(input_fn,c); WRITE(c); END; {output date of file} READLN(input_fn); {skip rest of line} WRITELN; WRITE('Maximum size of is font is '); READ(input_fn,max_f_w,max_f_h); WRITELN(max_f_w,' Wide and ',max_f_h,'high.'); READLN(input_fn); {skip rest of line} WRITELN; IF (Max_f_w > Max_Width) OR (max_f_h > Max_Height) THEN BEGIN WRITELN('ERROR -> defined font is larger than can be accepted'^G); GOTO restart; END; WRITE('defining characters --> '); count := 0; WHILE NOT EOF(input_fn) DO WITH trans_chr DO BEGIN FOR i := 1 TO Max_Height DO FOR j := 1 TO Max_Width DO pic[i,j] := ' '; {fill input map with all spaces} FOR i := 1 TO Max_Height DO FOR j := 1 TO Bit_Width DO bit_map[i,j] := 0; {fill output map with all spaces} READLN(input_fn,character,width,height); FOR i := 1 TO height DO BEGIN FOR j := 1 TO width DO READ(input_fn,pic[i,j]); READLN(input_fn) END; FOR i := 1 TO Max_Height DO BEGIN j := 1; WHILE j <= Max_Width DO BEGIN bit_tot := 0; IF pic[i,j ] <> ' ' THEN bit_tot := bit_tot + 1; IF pic[i,j+1] <> ' ' THEN bit_tot := bit_tot + 2; IF pic[i,j+2] <> ' ' THEN bit_tot := bit_tot + 4; IF pic[i,j+3] <> ' ' THEN bit_tot := bit_tot + 8; IF pic[i,j+4] <> ' ' THEN bit_tot := bit_tot + 16; IF pic[i,j+5] <> ' ' THEN bit_tot := bit_tot + 32; IF pic[i,j+6] <> ' ' THEN bit_tot := bit_tot + 64; IF pic[i,j+7] <> ' ' THEN bit_tot := bit_tot + 128; bit_map[i,ROUND((j+7)/8)] := bit_tot; j := j + 8 END END; WRITE(output_fn,trans_chr); {write out record to file} WRITE(character); {echo char just processed} count := count + 1; END; {with trans_chr} {END while} WRITELN; WRITELN; WRITELN('Number of characters defined in font file --> ',count); IF count < 96 THEN BEGIN WRITELN('Error! Font file must have at least 96 characters in it'^G); GOTO restart END; CLOSE(input_fn); CLOSE(output_fn); WRITELN; WRITELN('<<< MakeFont completed >>>') END.