unit YFonts;

interface
uses Crt, Graph, Mouse;

Type
  TTSingleChr = record
                  Btmp  : Array[1..13,1..13] of boolean;
                  Width : byte;
                end;

  TTFont      = Array[1..94] of TTSingleChr;

var
 Font   : TTFont;

Procedure LoadYTF(fn : string);
Procedure YOutText(s : string);
Procedure YOutTextB(s : string);
Function YTextHeight(s : string) : integer;
Function YTextWidth(s : string) : integer;

implementation

Procedure LoadYTF(fn : string);
var
 f : file of TTFont;
begin
   Assign(f,fn);
   Reset(f);
   Read(f,Font);
   close(f);
end;

Procedure PutCh(Ch : char);
var
 b : byte;
 x,y,c : integer;
 i,j   : integer;
begin
   b := ord(ch);
   b := b-31;
   x := getx;
   y := gety;
   c := GetColor;
   HideMouse;
   for j := 1 to 13 do
    for i := 1 to Font[b].Width do
     if Font[b].btmp[j,i] then
       PutPixel(x+i-1,y+j-1,c);

   MoveTo(x+Font[b].Width,y);
   ShowMouse;
end;

Procedure YOutText(s : string);
var
 i : integer;
begin
   for i := 1 to length(s) do
    PutCh(s[i]);
end;

Function YTextHeight(s : string) : integer;
begin
   YTextHeight := 13;
end;

Function YTextWidth(s : string) : integer;
var
 x,y,i,w,b : integer;
begin
   x:=getx+1;
   y:=gety;
   w:=0;
   for i := 1 to length(s) do
   begin
      b:=ord(s[i]);
      b:=b-31;
      w:=w+font[b].width;
   end;
   YTextWidth := w;
end;

Procedure YOutTextB(s : string);
var
 x,y,i : integer;
begin
   x:=getx+1;
   y:=gety;
   for i := 1 to length(s) do
   begin
      PutCh(s[i]);
      moveto(getx+1,gety);
   end;
   MoveTo(x,y);
   for i := 1 to length(s) do
   begin
      PutCh(s[i]);
      moveto(getx+1,gety);
   end;
end;

end.