freepascal.compiler/rtl/dos/ppi/font.ppi

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1993,97 by the Free Pascal development team.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

var
   defaultfontdata : array[0..2047] of byte;

function getfontpointer(b : byte):longint;
  begin
    dregs.RealSS:=0;
    dregs.RealSP:=0;
    dregs.RealEAX:=$1130;
    dregs.RealEBX:=longint(b shl 8);
    RealIntr($10,dregs);
    getfontpointer:=(longint(dregs.RealES) shl 4) + dregs.RealEBP and $FFFF; 
  end;

procedure getdefaultfont;
  var Sel : Word;
      linaddr : longint;

  begin
    { 8x8-Defaultfont aus BIOS laden }
    if isDPMI then begin
      SEL:=allocate_ldt_descriptors(1);
      linaddr:=getfontpointer(3);
      { I got problems because the fonts were at real mode segment $ffff
      so the address is above 1Mo and thus not locked !! }
      if linaddr+1024>$100000 then
        linaddr:=get_linear_addr(linaddr,1024);
      Set_segment_base_address(SEL,linaddr);
      Set_segment_limit(SEL,1024);
      movelong(sel,@defaultfontdata[0],$3FF);
      linaddr:=getfontpointer(4);
      if linaddr+1024>$100000 then
        linaddr:=get_linear_addr(linaddr,1024);
      Set_segment_base_address(SEL,linaddr);
      Set_segment_limit(SEL,1024);
      movelong(sel,@defaultfontdata[1024],$3FF);
      free_ldt_descriptor(SEL);
    end else begin
      move(pointer(getfontpointer(3)+core)^,defaultfontdata[0],1024);
      move(pointer(getfontpointer(4)+core)^,defaultfontdata[1024],1024);
    end;
  end;
 
{
  $Log$
  Revision 1.1  1998-03-25 11:18:42  root
  Initial revision

  Revision 1.3  1998/01/26 11:58:02  michael
  + Added log at the end


  
  Working file: rtl/dos/ppi/font.ppi
  description:
  ----------------------------
  revision 1.2
  date: 1997/12/01 12:21:29;  author: michael;  state: Exp;  lines: +14 -0
  + added copyright reference in header.
  ----------------------------
  revision 1.1
  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
  Initial revision
  ----------------------------
  revision 1.1.1.1
  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
  FPC RTL CVS start
  =============================================================================
}