[comp.lang.pascal] Turbo character font dumping

milne@ICS.UCI.EDU (Alastair Milne) (03/05/91)

  I have just made a most embarassing discovery: in response to some
  help I asked for concerning Turbo Pascal fonts, last summer,
  Naoto Kimura sent me this, with the program contained in it.
  He also asked that I forward it to the net, as their mail wasn't
  doing it properly.  I have just discovered that I haven't yet
  done so.  So, with abject apologies to Naoto, here it is at last.

  Alastair Milne

>> from Naoto:

By the way, if you hadn't noticed already, you can use the same font
files that Quattro uses.  There are a few undocumented fonts that you
can use.  Try using font numbers that are not already defined in the BGI.
You'll get a cursive font, a Eurostyle, and a complex font.

Speaking of stroked fonts... I've started on a program that would
convert the Hershey fonts to BGI format.  I've also am working on
a program to convert the BGI files into MetaGraphics font files
and back (some information is lost going from the MetaGraphics format
to the BGI).

About the bitmap character set:

As far as I can tell, the font is built into the BGI.  You can access
the bitmap font on the ROM BIOS ($f000:$f6ae) -- however only the first
128 are defined the next 128 are defined by an interrupt vector (in this
case it isn't really one, but rather a address of the table).  The
following program illustrates how you go about reading the ROM BIOS
character set.  You'll probably want to run the DOS GRAFTABL program to
load the second 128 characters into the memory and set the memory
vector to point to the table.

---- cut here -------- cut here -------- cut here -------- cut here ----
program apa;
uses Dos;

type
    Apa_Table   = array [$00..$7f] of array [$0..$7] of byte;
    TblPtr	= ^Apa_Table;

procedure DumpCharset (Tbl:TblPtr);
    const
	Patterns	: array [0..3] of char
			= ' ''.:';
	GPatterns	: array [0..3] of char
			= ' '#223#220#219;
    var
	i,j,s,t,b,o : byte;
    begin
	for i := $0 to $f do begin
	    for j := 0 to 3 do begin
		for o := 0 to 7 do begin
		    write('|');
		    s := Tbl^[o+(i shl 3),j shl 1];
		    t := Tbl^[o+(i shl 3),(j shl 1) + 1];
		    for b := 0 to 7 do begin
			Write(GPatterns[(s shr 7) or ((t shr 6) and 2)]);
			s := lo(s shl 1);
			t := lo(t shl 1)
		      end
		  end;
		writeln('|')
	      end;
	    writeln
	  end
    end;    (* DumpCharset *)

var
    P : Pointer;
begin
    DumpCharSet(ptr($f000,$fa6e));
    GetIntVec($1F,P);
    if P<>Nil then
	DumpCharSet(Addr(P^))
end.