home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-386-Vol-2of3.iso
/
b
/
bgi256-3.zip
/
FONTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-27
|
7KB
|
253 lines
{program to test the use of externally loaded BGI fonts}
{Writen by Michael Day as of 12/26/92 - public domain}
program FonTest;
{$IFDEF WINDOWS}
{$DEFINE PMODE}
--> This program doesn't work in Windows
{$ENDIF}
{$IFDEF DPMI}
uses WinApi,dos,graph;
{$DEFINE PMODE}
{$ENDIF}
{$IFNDEF PMODE}
uses dos,graph;
{$ENDIF}
type FontDef = array[0..7] of byte;
FontArray = array[0..255] of FontDef;
ByteArray = array[0..65520] of byte;
BytePtr = ^ByteArray;
const FontFileName = 'FNTIMG.DAT'; {user defined bit-map font}
BGIFileName = 'BGI256.BGI';
const FontSelector : longint = 0; {protected mode font selector}
FontPtr : ^FontArray = nil; {pointer to our font table}
BGIptr : BytePtr = nil; {pointer to the BGI driver}
Old1fPtr : pointer = nil; {storage for old $1f int vec}
RealIntOfs : word = 0; {storage for old real mode}
RealIntSeg : word = 0; { in vect when in protected mode}
BGISize : word = 0; {size of bgi driver}
StartMode : integer = 0; {startup mode}
var gd,gm : integer;
err : integer;
s : string;
{----------------------------------------------------------------}
function AutoDet:integer; far;
begin
AutoDet := StartMode;
end;
{$IFDEF PMODE}
procedure GetRealIntVec(Inum:byte; var OfsVal,SegVal:word);
begin
asm
mov ax,$0200 {in pmode we have to use dpmi services}
mov bl,[Inum] {to get the real mode interrupt}
int $31
les bx,[OfsVal]
mov es:[bx],dx
les bx,[SegVal]
mov es:[bx],cx
end;
end;
procedure SetRealIntVec(Inum:byte; OfsVal,SegVal:word);
begin
asm
mov ax,$0201 {in pmode we have to use dpmi services}
mov bl,[Inum] {to set the real mode interrupt}
mov dx,[OfsVal]
mov cx,[SegVal]
int $31
end;
end;
{$ENDIF}
{---------------------------------------------------------}
{Load the font definition file}
function LoadFont(FontFileName:string):boolean;
var f : file of FontArray;
begin
LoadFont := false;
{$IFDEF PMODE} {if pmode, alloc the data in dos memory area}
if FontSelector = 0 then
FontSelector := GlobalDosAlloc(sizeof(FontPtr^));
if FontSelector = 0 then Exit;
FontPtr := ptr(loword(FontSelector),0);
{$ELSE}
if FontPtr = nil then
begin
if MaxAvail < sizeof(FontPtr^) then Exit;
New(FontPtr); {if real mode just grab it off the heap}
end;
{$ENDIF}
if IOResult = 0 then {nop};
assign(f,FontFileName);
reset(f);
Read(f,FontPtr^); {read the font into memory}
close(f);
if IOResult = 0 then
begin {if valid file point the int vec at the font}
{$IFDEF PMODE}
SetRealIntVec($1f,Ofs(FontPtr^[128]),hiWord(FontSelector));
{$ENDIF}
SetIntVec($1f,@FontPtr^[128]);
LoadFont := true;
end;
end;
{-------------------------------------------------}
{load the bgi driver into memory}
function LoadBGI(DriverName:string):boolean;
var f:file;
Count:word;
begin
LoadBGI := false;
assign(f,DriverName);
reset(f,1);
if (BGIptr <> nil) and (BGISize <> 0) then
begin
FreeMem(BGIptr,BGISize);
end;
BGISize := FileSize(f);
if MaxAvail < BGISize then
begin
close(f);
Exit;
end;
GetMem(BGIptr,BGISize);
BlockRead(f,BGIptr^,BGISize,Count);
close(f);
LoadBGI := true;
end;
procedure ShowFont;
var i,x,y:integer;
begin
x := 1;
y := 1;
for i := 0 to 255 do
begin
outtextxy(x,y,char(i));
x := x + 10;
if i and $1f = $1f then
begin
y := y + 10;
x := 1;
end;
end;
end;
{--------------------------------------------}
{release resources and turn things off}
procedure ShutDown;
begin
closegraph; {turn off graphics mode}
if (BGIptr <> nil) and (BGISize <> 0) then
FreeMem(BGIptr,BGISize); {release bgi driver memory}
SetIntVec($1f,Old1fPtr); {restore old int vect ptr}
{$IFDEF PMODE}
SetRealIntVec($1f,RealIntOfs,RealIntSeg);
if FontSelector <> 0 then {release font dos memory}
FontSelector := GlobalDosFree(sizeof(FontPtr^));
FontPtr := nil;
{$ELSE}
if FontPtr <> nil then
Dispose(FontPtr); {release heap allocation for font}
FontPtr := nil;
{$ENDIF}
end;
var i,x,y,z,q:integer;
c : byte;
cp : ^Fontarray;
{-Main-}
begin
if ParamCount > 0 then
S := ParamStr(1);
StartMode := ord(s[1]) and $f;
{$IFDEF PMODE}
GetRealIntVec($1f,RealIntOfs,RealIntSeg); {save current vect}
{$ENDIF}
GetIntVec($1f,Old1fptr);
if not LoadFont(FontFileName) then
begin
writeln('Error; Could not load font file: ',FontFileName);
halt(1);
end;
if not LoadBGI(BGIFileName) then
begin
writeln('Error: Could not load BGI file: ',BGIFileName);
Halt(1);
end
else
begin
gd := InstallUserDriver('BGI256',@AutoDet);
gd := RegisterBGIdriver(BGIptr); {register our own driver}
if gd < 0 then
begin
writeln('Error: Could not register BGI driver: ',BGIFileName);
{$IFDEF PMODE}
{all bgi drivers have the version number at this location}
if BGIptr^[$86] < 3 then
writeln(' ** Wrong driver version for Pmode operation **');
{$ENDIF}
Halt(1);
end;
end;
gd := 0;
gm := 0;
initgraph(gd,gm,''); {startup the graphics system}
err := GraphResult;
if err <> 0 then
begin
writeln('Error: Could not init graphics device: ');
writeln(GraphErrorMsg(Err));
halt(1);
end;
ShowFont; {show 'em what we got}
(*
cp := pointer(FontPtr); {in case you want to see in it a different}
for i := 0 to 255 do {way, I provided this. It is useful for}
begin {debugging to prove what is in the font}
for q := 0 to 7 do {table that we loaded. Especially useful}
begin {for protected mode when you forget about}
for z := 0 to 7 do {real mode requirement for the interrupt}
begin
if ((q = 0) and (z = 0)) or ((q = 7) and (z = 7)) or
((q = 0) and (z = 7)) or ((q = 7) and (z = 0)) then c := 1 else
c := ((cp^[i][q] shl z) and $80) shr 6;
y := ((i shr 5) * 10) + q + 100;
x := ((i and $1f) * 10) + z;
putpixel(x,y,c);
end;
end;
end;
*)
readln; {hang around until return is hit}
ShutDown; {close up shop and go home}
end.