home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 13 / CDA13.ISO / cdactual / demobin / share / program / Pascal / BGI256.ZIP / FONTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-27  |  6.5 KB  |  253 lines
  1.  
  2. {program to test the use of externally loaded BGI fonts}
  3. {Writen by Michael Day as of 12/26/92 - public domain}
  4.  
  5. program FonTest;
  6.  
  7. {$IFDEF WINDOWS}
  8.   {$DEFINE PMODE}
  9.   --> This program doesn't work in Windows
  10. {$ENDIF}
  11. {$IFDEF DPMI}
  12.   uses WinApi,dos,graph;
  13.   {$DEFINE PMODE}
  14. {$ENDIF}
  15. {$IFNDEF PMODE}
  16.   uses dos,graph;
  17. {$ENDIF}
  18.  
  19. type  FontDef = array[0..7] of byte;
  20.       FontArray = array[0..255] of FontDef;
  21.       ByteArray = array[0..65520] of byte;
  22.       BytePtr = ^ByteArray;
  23.  
  24. const FontFileName = 'FNTIMG.DAT';  {user defined bit-map font}
  25.       BGIFileName = 'BGI256.BGI';
  26.  
  27. const FontSelector : longint = 0;   {protected mode font selector}
  28.       FontPtr  : ^FontArray = nil;  {pointer to our font table}
  29.       BGIptr   : BytePtr = nil;     {pointer to the BGI driver}
  30.       Old1fPtr : pointer = nil;     {storage for old $1f int vec}
  31.       RealIntOfs : word = 0;        {storage for old real mode}
  32.       RealIntSeg : word = 0;        { in vect when in protected mode}
  33.       BGISize : word = 0;           {size of bgi driver}
  34.       StartMode : integer = 0;      {startup mode}
  35.  
  36. var   gd,gm : integer;
  37.       err : integer;
  38.       s : string;
  39.  
  40.  
  41. {----------------------------------------------------------------}
  42.  
  43. function AutoDet:integer; far;
  44. begin
  45.   AutoDet := StartMode;
  46. end;
  47.  
  48.  
  49. {$IFDEF PMODE}
  50. procedure GetRealIntVec(Inum:byte; var OfsVal,SegVal:word);
  51. begin
  52.    asm
  53.      mov ax,$0200   {in pmode we have to use dpmi services}
  54.      mov bl,[Inum]  {to get the real mode interrupt}
  55.      int $31
  56.      les bx,[OfsVal]
  57.      mov es:[bx],dx
  58.      les bx,[SegVal]
  59.      mov es:[bx],cx
  60.    end;
  61. end;
  62.  
  63. procedure SetRealIntVec(Inum:byte; OfsVal,SegVal:word);
  64. begin
  65.    asm
  66.      mov ax,$0201   {in pmode we have to use dpmi services}
  67.      mov bl,[Inum]  {to set the real mode interrupt}
  68.      mov dx,[OfsVal]
  69.      mov cx,[SegVal]
  70.      int $31
  71.    end;
  72. end;
  73. {$ENDIF}
  74.  
  75. {---------------------------------------------------------}
  76. {Load the font definition file}
  77. function LoadFont(FontFileName:string):boolean;
  78. var f : file of FontArray;
  79. begin
  80.    LoadFont := false;
  81.    {$IFDEF PMODE}       {if pmode, alloc the data in dos memory area}
  82.      if FontSelector = 0 then
  83.        FontSelector := GlobalDosAlloc(sizeof(FontPtr^));
  84.      if FontSelector = 0 then Exit;
  85.      FontPtr := ptr(loword(FontSelector),0);
  86.    {$ELSE}
  87.      if FontPtr = nil then
  88.      begin
  89.        if MaxAvail < sizeof(FontPtr^) then Exit;
  90.        New(FontPtr);    {if real mode just grab it off the heap}
  91.      end;
  92.    {$ENDIF}
  93.  
  94.    if IOResult = 0 then {nop};
  95.    assign(f,FontFileName);
  96.    reset(f);
  97.    Read(f,FontPtr^);    {read the font into memory}
  98.    close(f);
  99.    if IOResult = 0 then  
  100.    begin               {if valid file point the int vec at the font}
  101.      {$IFDEF PMODE}
  102.        SetRealIntVec($1f,Ofs(FontPtr^[128]),hiWord(FontSelector));
  103.      {$ENDIF}
  104.      SetIntVec($1f,@FontPtr^[128]);
  105.      LoadFont := true;
  106.    end;
  107. end;
  108.  
  109. {-------------------------------------------------}
  110. {load the bgi driver into memory}
  111. function LoadBGI(DriverName:string):boolean;
  112. var f:file;
  113.     Count:word;
  114. begin
  115.    LoadBGI := false;
  116.    assign(f,DriverName);
  117.    reset(f,1);
  118.    if (BGIptr <> nil) and (BGISize <> 0) then
  119.    begin
  120.      FreeMem(BGIptr,BGISize);
  121.    end;
  122.  
  123.    BGISize := FileSize(f);
  124.    if MaxAvail < BGISize then
  125.    begin
  126.      close(f);
  127.      Exit;
  128.    end;
  129.    GetMem(BGIptr,BGISize);
  130.    BlockRead(f,BGIptr^,BGISize,Count);
  131.    close(f);
  132.    LoadBGI := true;
  133. end;
  134.  
  135.  
  136. procedure ShowFont;
  137. var i,x,y:integer;
  138. begin
  139.   x := 1;
  140.   y := 1;
  141.   for i := 0 to 255 do
  142.   begin
  143.     outtextxy(x,y,char(i));
  144.     x := x + 10;
  145.     if i and $1f = $1f then
  146.     begin
  147.       y := y + 10;
  148.       x := 1;
  149.     end;
  150.   end;
  151. end;
  152.  
  153.  
  154. {--------------------------------------------}
  155. {release resources and turn things off}
  156. procedure ShutDown;
  157. begin
  158.   closegraph;    {turn off graphics mode}
  159.   if (BGIptr <> nil) and (BGISize <> 0) then
  160.     FreeMem(BGIptr,BGISize);  {release bgi driver memory}
  161.   SetIntVec($1f,Old1fPtr);    {restore old int vect ptr}
  162.   {$IFDEF PMODE}
  163.     SetRealIntVec($1f,RealIntOfs,RealIntSeg);
  164.     if FontSelector <> 0 then {release font dos memory}
  165.        FontSelector := GlobalDosFree(sizeof(FontPtr^));
  166.     FontPtr := nil;
  167.   {$ELSE}
  168.     if FontPtr <> nil then
  169.       Dispose(FontPtr);       {release heap allocation for font}
  170.     FontPtr := nil;
  171.   {$ENDIF}
  172. end;
  173.  
  174.  
  175. var i,x,y,z,q:integer;
  176.     c : byte;
  177.     cp : ^Fontarray;
  178.  
  179. {-Main-}
  180. begin
  181.   if ParamCount > 0 then
  182.     S := ParamStr(1);
  183.   StartMode := ord(s[1]) and $f;
  184.  
  185.   {$IFDEF PMODE}
  186.     GetRealIntVec($1f,RealIntOfs,RealIntSeg);  {save current vect}
  187.   {$ENDIF}
  188.   GetIntVec($1f,Old1fptr);
  189.   if not LoadFont(FontFileName) then
  190.   begin
  191.     writeln('Error; Could not load font file: ',FontFileName);
  192.     halt(1);
  193.   end;
  194.  
  195.   if not LoadBGI(BGIFileName) then
  196.   begin
  197.     writeln('Error: Could not load BGI file: ',BGIFileName);
  198.     Halt(1);
  199.   end
  200.   else
  201.   begin
  202.     gd := InstallUserDriver('BGI256',@AutoDet);
  203.     gd := RegisterBGIdriver(BGIptr);   {register our own driver}
  204.     if gd < 0 then
  205.     begin
  206.       writeln('Error: Could not register BGI driver: ',BGIFileName);
  207.       {$IFDEF PMODE}
  208.         {all bgi drivers have the version number at this location}
  209.         if BGIptr^[$86] < 3 then
  210.           writeln(' ** Wrong driver version for Pmode operation **');
  211.       {$ENDIF}
  212.       Halt(1);
  213.     end;
  214.   end;
  215.  
  216.   gd := 0;
  217.   gm := 0;
  218.   initgraph(gd,gm,'');   {startup the graphics system}
  219.   err := GraphResult;
  220.   if err <> 0 then
  221.   begin
  222.     writeln('Error: Could not init graphics device: ');
  223.     writeln(GraphErrorMsg(Err));
  224.     halt(1);
  225.   end;
  226.  
  227.   ShowFont;              {show 'em what we got}
  228.  
  229. (*
  230.   cp := pointer(FontPtr);  {in case you want to see in it a different}
  231.   for i := 0 to 255 do     {way, I provided this. It is useful for}
  232.   begin                    {debugging to prove what is in the font}
  233.     for q := 0 to 7 do     {table that we loaded. Especially useful}
  234.     begin                  {for protected mode when you forget about}
  235.       for z := 0 to 7 do   {real mode requirement for the interrupt}
  236.       begin
  237.         if ((q = 0) and (z = 0)) or ((q = 7) and (z = 7)) or
  238.            ((q = 0) and (z = 7)) or ((q = 7) and (z = 0)) then c := 1 else
  239.         c := ((cp^[i][q] shl z) and $80) shr 6;
  240.         y := ((i shr 5) * 10) + q + 100;
  241.         x := ((i and $1f) * 10) + z;
  242.         putpixel(x,y,c);
  243.       end;
  244.     end;
  245.   end;
  246. *)
  247.  
  248.   readln;   {hang around until return is hit}
  249.  
  250.   ShutDown; {close up shop and go home}
  251. end.
  252.  
  253.