nelson@sun.soe.clarkson.edu (Russ Nelson) (04/09/90)
In article <1721@sparko.gwu.edu> sc155113@seas.gwu.edu (Timur Tabi) writes: Can anyone tell me what the bitmap definition is for Fontasy's font files? Better yet, does anyone have a conversion program? I have over unique fonts which I want to convert to HP's .SFP format. Here is a program that I wrote to convert Fontasy fonts to Painter's Apprentice fonts. The program isn't well-commented, but you ought to be able to figure it out given a few Fontasy fonts: { History:173 } const charset : set of char = [' '..'~']; max_font_size = 400; type str255 = string[255]; byte_array = array[0..max_font_size] of byte; var font_name : str255; font_header : record ascent : integer; descent : integer; maxWid : integer; leading : integer; num_char : integer end; font_index : array[' '..'~'] of record exist : boolean; width : byte; definition : byte_array; end; missing : byte_array; misswid : byte; procedure write_font(fn : str255); var out_file : file; ch : char; height : integer; begin with font_header do begin num_char := 0; for ch := ' ' to '~' do if font_index[ch].exist then num_char := num_char + 1; end; with font_header do begin height := ascent + descent; end; { get file set up } if pos('.', fn)=0 then fn := fn + '.FNT'; assign(out_file, fn); rewrite(out_file, 1); { write font name } blockwrite(out_file, font_name[1], length(font_name)); ch := #0; blockwrite(out_file, ch, 1); font_header.leading := height div 8 + 1; blockwrite(out_file, font_header, sizeof(font_header)); misswid := font_header.maxWid - 2; fillchar(missing[0], ((misswid + 7) div 8) * height, $ff); blockwrite(out_file, misswid, 1); blockwrite(out_file, missing[0], height * ((misswid + 7) div 8)); for ch := ' ' to '~' do with font_index[ch] do begin if exist then begin blockwrite(out_file, ch, 1); blockwrite(out_file, width, 1); blockwrite(out_file, definition[0], height * ((width + 7) div 8)); end; end; close(out_file); end; procedure adjust_ascent; const sizes : array[1..9] of integer = (9, 10, 12, 14, 18, 24, 36, 48, 72); var i : integer; begin i := 1; while font_header.ascent >= sizes[i] do i := i + 1; if i > 1 then i := i - 1; font_header.descent := font_header.ascent - sizes[i]; font_header.ascent := sizes[i]; end; const code_str : str255 = '(C)1984WKMASON'; var inf : file; code_i : integer; function getch : byte; var by : byte; begin blockread(inf, by, 1); by := by xor (ord(code_str[code_i]) or $80); if code_i=length(code_str) then code_i := 1 else code_i := code_i + 1; getch := by; end; var repeating : boolean; repeat_count : integer; repeat_byte : byte; function getbyte : byte; var by : byte; begin if repeating then begin repeat_count := repeat_count - 1; if repeat_count=0 then repeating := false; getbyte := repeat_byte; end else begin by := getch; if by<>$55 then getbyte := by else begin repeating := true; repeat_count := getch; repeat_byte := getch; getbyte := getbyte; end; end; end; {$U+} function real_width(ch : char) : integer; var i, wid, ptr : integer; bit : byte; bytes : integer; columns : array[0..20] of byte; begin with font_index[ch] do begin bytes := (width + 7) shr 3; fillchar(columns, sizeof(columns), 0); for ptr := 0 to bytes - 1 do begin for i := 0 to font_header.ascent + font_header.descent - 1 do begin columns[ptr] := columns[ptr] or definition[i*bytes + ptr]; end; end; wid := width; bit := 1; ptr := bytes - 1; while (wid>0) and ((columns[ptr] and bit) = 0) do begin if bit=$80 then begin bit := 1; ptr := ptr - 1; end else bit := bit shl 1; wid := wid - 1; end; end; real_width := wid - 1; end; {$U-} type rect = record left : integer; top : integer; right : integer; bot : integer; end; verbs = (pset_verb, and_not_verb, or_verb, xor_verb); bitmap = record bounds : rect; bytes : integer; pointer : ^byte; end; procedure blit(src, dest : bitmap; mode : verbs); external 'blit.com'; procedure copy_char(ch : char; old_width, new_width : integer); var src, dest : bitmap; new_char : byte_array; begin with font_index[ch] do begin src.bounds.top := 0; src.bounds.left := 0; src.bounds.bot := font_header.ascent + font_header.descent; src.bounds.right := new_width; src.bytes := (old_width + 7) shr 3; src.pointer := addr(definition); dest.bounds.top := 0; dest.bounds.left := 0; dest.bytes := (new_width + 7) shr 3; dest.pointer := addr(new_char); blit(src, dest, pset_verb); definition := new_char; end; end; var ch : char; bit, by : byte; ptr : integer; bytes : integer; fnt_idx : integer; fnt_char : char; header : record fy_bytes : integer; fy_width : byte; fy_height : byte; fy_count : byte; fy_unk1 : byte; fy_unk2 : byte; fy_unk3 : byte; end; header_array : array[1..10] of byte absolute header; i, j, k : integer; new_width : byte; in_file_name : str255; begin if paramcount<1 then begin writeln('usage: fy2fnt fyname[.FY] [fntname[.FNT]]'); halt(2); end; if paramcount < 2 then font_name := paramstr(1) else font_name := paramstr(2); i := pos('.', font_name); if i<>0 then font_name := copy(font_name, 1, i-1); i := pos(':', font_name); if i<>0 then font_name := copy(font_name, 3, 255); in_file_name := paramstr(1); if pos('.', in_file_name)=0 then in_file_name := in_file_name + '.FY'; assign(inf, in_file_name); reset(inf, 1); code_i := 1; repeating := false; for i := 1 to sizeof(header) do header_array[i] := getch; writeln('bytes = ',header.fy_bytes); writeln('width = ',header.fy_width); writeln('height= ',header.fy_height); writeln('count = ',header.fy_count); writeln('unk1 = ',header.fy_unk1); writeln('unk2 = ',header.fy_unk2); writeln('unk3 = ',header.fy_unk3); for ch := ' ' to '~' do font_index[ch].exist := false; font_header.maxWid := 0; font_header.ascent := 0; font_header.descent := 0; fillchar(font_index[' '].definition, max_font_size, 0); font_index[' '].exist := true; font_index[' '].width := 8; bytes := (header.fy_width+7) shr 3; for fnt_char := '!' to chr(ord(' ') + header.fy_count) do if not (fnt_char in charset) then begin for i := 1 to header.fy_bytes do by := getbyte; end else with font_index[fnt_char] do begin exist := true; fillchar(definition, max_font_size, 0); for i := 0 to header.fy_height-1 do begin bit := $80; ptr := 0; for j := 0 to header.fy_width-1 do begin by := getbyte; for k := 7 downto 0 do begin fnt_idx := (i*8+k)*bytes + ptr; if (by and 1)<>0 then definition[fnt_idx] := definition[fnt_idx] or bit; by := by shr 1; end; if bit=1 then begin ptr := ptr + 1; bit := $80 end else bit := bit shr 1; end; end; end; font_header.maxWid := header.fy_width; font_header.ascent := header.fy_bytes div (header.fy_width shr 3); font_header.descent := 0; for fnt_char := '!' to chr(ord(' ') + header.fy_count) do if fnt_char in charset then with font_index[fnt_char] do if exist then begin width := getch; { new_width := real_width(fnt_char); writeln(fnt_char,' ',width,' ',new_width); } if width=0 then exist := false else copy_char(fnt_char, header.fy_width, width); end; adjust_ascent; writeln('ascent of font = ',font_header.ascent); writeln('descent of font = ',font_header.descent); if font_header.descent<0 then font_header.descent := 0; close(inf); if paramcount < 2 then write_font(paramstr(1)) else write_font(paramstr(2)); end. -- --russ (nelson@clutx [.bitnet | .clarkson.edu]) Russ.Nelson@$315.268.6667 Violence never solves problems, it just changes them into more subtle problems Clarkson will be featured on PBS's Computer Chronicles this week.