unit vnm_fnt;
{****************************************************************************}
{Unit VNM_FNT - it is a addon unit for graphics library VenomGFX.             }
{It brings a loader for .FNT bitmap font file.                                }
{****************************************************************************}

{$IFDEF VER2}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF VER3}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF NEWFPC}{$CALLING OLDFPCCALL}{$ENDIF}
interface
uses VnmFnHlp;

type
PFontFNT = ^TFontFNT;
TFontFNT = object(TBitMapZnaky256)
{vnitrnijmeno:string[32];}
maxpred,maxza,maxnad,maxpod:shortint;

Constructor Init;
Function Load_FNT(s:string;kde,velbuf:longint):boolean;
Function Otestuj_podformat_GRX(buf:pointer):boolean;
Function Load_Subformat_GRX(buf:pointer):boolean;
Function VyskaRadky:byte;virtual;
Function VratVelikost:byte;virtual;
Destructor Done;virtual;
end;

Function Zkontroluj_Format_FNT(s:string):boolean;
Function Load_FNT_font(s:string;size:longint):pointer;
Function Load_FNT_font_z_FON(s:string;kde,vels:longint):pointer;

var global_fnt_loader_popisek1:string;
    global_fnt_loader_popisek2:string[64];

const vnm_fn_dbg:byte=0;

implementation
uses GrpFile,VenomGFX,VenomMng;

type
pFNT_header = ^tFNT_header;
tFNT_header = packed record
{00}  version:word;
{02}  size:longint;
{06}  popisek:packed array[0..59] of char;
{66}  typ:word;
{68}  points:word;
{70}  vertres:word;
{72}  horzres:word;
{74}  ascend:word;
{76}  intleading:word; {byte}
{78}  extleading:word; {byte}
{80}  is_italic:byte;
{81}  is_underline:byte;
{82}  is_strikeout:byte;
{83}  weight:word;
{85}  charset:byte;
{86}  pixwidth:word;
{88}  pixheight:word;
{90}  family:byte;
{91}  avgwidth:word;
{93}  maxwidth:word;
{95}  firstchar:byte;
{96}  lastchar:byte;
{97}  defaultchar:byte;
{98}  breakchar:byte;
{99}  widthbytes:word;
{101} device:longint;
{105} facestr:longint;
{109} bitspointer:longint;
{113} bitoffset:longint;
{117} reserved1:byte;
{.....a vypada to, ze zbytek polozek je jenom pro format 300h, nikoliv 200h}
{...pro format 200h je to tak, ze na offsetu 118 zacina pole s CharInfo}
{118} flags:longint;
{122} a_space:word;
{124} b_space:word;
{126} c_space:word;
{128} colorpointer:longint;
{132} reserved2:packed array[0..15] of byte;
end;


pGRX_FNT_header = ^tGRX_FNT_header;
tGRX_FNT_header = packed record
{00}  magic:dword;
{04}  bmpsize:longint;             {character bitmap size}
{08}  width:word;                  {width (average for proportional)}
{10}  height:word;                 {font height}
{12}  minchar:word;                {lowest character code in font}
{14}  maxchar:word;                {highest character code in font}
{16}  isfixed:word;                {nonzero if fixed font}
{18}  reserved:word;               {???}
{20}  baseline:word;               {baseline from top of font}
{22}  undwidth:word;               {underline width (at bottom)}
{24}  fnname:packed array[0..15] of char; {font file name (w/o path)}
{40}  family:packed array[0..15] of char; {font family name}
{56}
end;


function MyVal (S: string): longint;
var
  Pom2 : Integer;
  pom1 : longint;
begin { MyVal }
  Val (S, Pom1, Pom2);
  MyVal := Pom1;
end;  { MyVal }


Function Zkontroluj_Format_FNT(s:string):boolean;
var grp:TGrpStream;
    mgl:byte;
    ss:string;
    hdr:tFNT_header;

begin
grp.Init(DoplnJmenoFontu(s),grpOpenRead);
if grp.status<>grpOK then Exit(false);
if grp.GetSize<130 then
   begin
   grp.Done;
   Exit(false);
   end;

grp.Read(hdr,sizeof(tFNT_header));
grp.Done;

if (hdr.version<>$200) {and (hdr.version<>$300)} then Exit(false);
if (hdr.typ and 255)<>0 then Exit(false);
{zajima nas jen bitmapovy podformat}

Zkontroluj_Format_FNT:=true;
end;


Constructor TFontFNT.Init;
begin
inherited Init(0);
prop:=true;
format:=FNFMT_FNT;
end;


Function TFontFNT.Otestuj_podformat_GRX(buf:pointer):boolean;
var ll:^dword;
begin
ll:=buf;
Otestuj_podformat_GRX:=ll^=$19590214;
end;



Function TFontFNT.Load_Subformat_GRX(buf:pointer):boolean;
{Jiny format fontu s priponou FNT. Nema nic spolecneho s Microsoftem, ale
 je pouzit v grafickych knihovnach GRX, MGRX a Allegro}

var hdr:pGRX_FNT_header;
    pp,qq,qd:pchar;
    bitmapa_prazdna:boolean;
    globsirka,globvyska,char_s,hdrs:longint;
    a,b,c,d,n:longint;
    _w:^word;
    b2b:packed array[0..7] of byte;
    pole1d:packed array[0..4095] of byte;

begin
hdr:=buf;
pp:=buf;
format:=FNFMT_GRXFNT;       {preci jen jde o zcela jiny format nez MS/FNT}
hdrs:={SizeOf(tGRX_FNT_header);}56;
prop:=hdr^.isfixed<>0;

{a:=word(hdr^.minchar);
b:=word(hdr^.maxchar);
c:=b-a;
c:=c+1;}

first:=hdr^.minchar;
last:=hdr^.maxchar;
pocetzn:=last-first+1;
globsirka:=hdr^.width;
globvyska:=hdr^.height;
so:=hdr^.baseline;
su:=globvyska-hdr^.baseline;
max_sirka_bitmapy:=0;
if su<0 then su:=0;
sosu:=so+su;
vel:=globvyska;

if hdr^.isfixed=0 then
   begin
   {tabulka sirek znaku}
   {bezprostredne za hlavickou nasleduje POCETZN wordu}
   qq:=@pp[hdrs+pocetzn*2{-2}];
   end
   else qq:=@pp[hdrs+0];


for a:=first to last do
    begin
    if hdr^.isfixed=0
       then begin _w:=@pp[hdrs+(a-first)*2];char_s:=_w^;end
       else char_s:=globsirka;

    if char_s>max_sirka_bitmapy then max_sirka_bitmapy:=char_s;

    Znaky256[a].Init;
    znaky256[a].sirka:=char_s;
    znaky256[a].vyska:=globvyska;

    znaky256[a].relY:=-so;
    znaky256[a].relX:=0;
    znaky256[a].shift:=char_s;
    znaky256[a].ready:=2;

    n:=(char_s+7) div 8;    {pocet bajtu ve kterych je rozepsan radek}

    znaky256[a].dp:=char_s*globvyska;          {nekomprimovany mod}
    GetMem(znaky256[a].data,znaky256[a].dp);   {buffer pro nekomprimovana}
    qd:=znaky256[a].data;

    bitmapa_prazdna:=true;


        if a=200 then
       b:=b;


    for b:=1 to globvyska do
        begin
        d:=0;
        for c:=1 to n do
            begin
            if qq^<>#0 then bitmapa_prazdna:=false;
            ZnakBuf_Expand(byte(qq^),@b2b);
            inc(qq);
            Move(b2b,pole1d[d],8);
            inc(d,8);
            end;

        Move(pole1d,qd^,char_s);
        inc(qd,char_s);
        end;


    if (char_s<=1) and (bitmapa_prazdna=true)
       then begin
       Znaky256[a].Done;
       dec(pocetzn);
       if a=first then inc(first);
       if a=last then dec(last);
       {znak jednobodove sirky a prazdny - hodnotim jako realne nedefinovany.
        Takove znaky budu vyrazovat}
       end
       else znaky256[a].Komprimuj;
    {znak jsme dekomprimovali, ale ted ho prekvapive budu znovu komprimovat
     predchozi komprese totiz pakovala jednotlive radky zvlast, kdezto ja
     zapakuju celou bitmapu vcelku}
    end;

if pocetzn=0 then begin first:=0;last:=0;end;

global_fnt_loader_popisek1[0]:=#16;
Move(hdr^.fnname,global_fnt_loader_popisek1[1],16);

b:=0;
for a:=16 downto 1 do
    if global_fnt_loader_popisek1[a] in [#0,#32] then inc(b) else Break;
dec(global_fnt_loader_popisek1[0],b);


global_fnt_loader_popisek2[0]:=#16;
Move(hdr^.family,global_fnt_loader_popisek2[1],16);
b:=0;
for a:=16 downto 1 do
    if global_fnt_loader_popisek2[a] in [#0,#32] then inc(b) else Break;
dec(global_fnt_loader_popisek2[0],b);


Load_Subformat_GRX:=true;
end;



Function TFontFNT.Load_FNT(s:string;kde,velbuf:longint):boolean;
var grp:TGrpStream;
    ss:string;
    vyska,sirka:longint;
    a,x,y,i,sx,sloupce:longint;
    b:pbyte;
    p:pchar;
    facestr:pchar;
    pole2d:array[0..99,0..99] of byte;
    b2b:array[0..7] of byte;

    pole1d:array[0..4095] of byte;
    hdr:pFNT_header;
    buf:pchar;
    znd:pchar;
    znd_add:byte;
    bufsize:longint;
    bmp:pointer;
    znak_pro_mezeru:byte;
    pw:^word;
    pl:^longint;
    hfl:longint;
    is_fixedpitch,is_prop,is_abcfixed,is_abcprop:boolean;
    color_fmt:byte;
    char_s:longint;
    char_o:longint;
    z:PZnak;

begin
ss:=DoplnJmenoFontu(s);
grp.Init(ss,grpOpenRead);
if grp.status<>grpOK then Exit(false);

if velbuf=0 then
   begin
   bufsize:=grp.GetSize;
   if bufsize<130 then
      begin
      grp.Done;
      Exit(false);
      end;
   end
   else bufsize:=velbuf;

GetMem(buf,bufsize);
grp.Seek(kde);
grp.Read(buf^,bufsize);
grp.Done;


if Otestuj_podformat_GRX(buf) then
   begin
   Load_FNT:=Load_Subformat_GRX(buf);
   FreeMem(buf);
   Exit;
   end;

hdr:=pointer(buf);
if (hdr^.version<>$200) {and (hdr^.version<>$300)} then
   begin FreeMem(buf);Exit(false);end;

prop:=(hdr^.family and 1)<>0;
first:=hdr^.firstchar;
last:=hdr^.lastchar;
pocetzn:=last-first+1;
znak_pro_mezeru:=hdr^.breakchar+hdr^.firstchar;
sirka:=hdr^.pixwidth;
vyska:=hdr^.pixheight;
so:=hdr^.ascend;
su:=vyska-hdr^.ascend;
max_sirka_bitmapy:=0;
if su<0 then su:=0;
sosu:=so+su;
vel:=vyska;

facestr:=@hdr^.popisek;
global_fnt_loader_popisek1:=facestr;

facestr:=@buf[hdr^.facestr];
global_fnt_loader_popisek2:=facestr;


bmp:=@buf[hdr^.bitoffset];

if hdr^.version=$300 then
   begin
   znd_add:=6;
   {
   hfl:=hdr^.flags;
   is_fixedpitch:=(hfl and 1)<>0;
   is_prop:=(hfl and 2)<>0;
   is_abcfixed:=(hfl and 4)<>0;
   is_abcprop:=(hfl and 8)<>0;

   if (hfl and $10)<>0 then color_fmt:=1 else
   if (hfl and $20)<>0 then color_fmt:=2 else
   if (hfl and $40)<>0 then color_fmt:=3 else
   if (hfl and $80)<>0 then color_fmt:=4 else color_fmt:=0;

   if color_fmt=0 then begin FreeMem(buf);Exit(false)end;
   }
   end
   else begin color_fmt:=1;znd_add:=4;end;

if znd_add=4
   then znd:=@buf[118]
   else znd:=@buf[130];

{ZND je ted na zacatku pole dfCharTable}

for a:=first to last do
    begin
    pw:=pointer(znd);
    if znd_add=4 then
       begin
       char_s:=word(pw^);
       inc(pw);   {pricte dva bajty adresy, protoze jsme ^word}
       char_o:=word(pw^);
       end
       else begin
       char_s:=word(pw^);
       inc(pw);   {pricte dva bajty adresy, protoze jsme ^word}
       pl:=pointer(pw);
       char_o:=longint(pl^);
       end;
    inc(znd,znd_add);

    Znaky256[a].Init;
    znaky256[a].sirka:=char_s;
    znaky256[a].vyska:=vyska;
    znaky256[a].dp:=znaky256[a].sirka*znaky256[a].vyska;
    if znaky256[a].dp>0 then
       GetMem(znaky256[a].data,znaky256[a].dp);
    znaky256[a].relY:=-so;
    znaky256[a].relX:=0;
    znaky256[a].shift:=char_s;
    znaky256[a].ready:=2;

    if char_s>max_sirka_bitmapy then max_sirka_bitmapy:=char_s;
     sloupce:=(char_s div 8);
    FillChar(pole2d,sizeof(pole2d),0);
    FillChar(pole1d,sizeof(pole1d),0);

    if char_s>0 then
       begin
       for sx:=0 to sloupce do
           for y:=0 to vyska-1 do
               begin
               b:=@buf[char_o+(sx*vyska)+y];
               ZnakBuf_Expand(b^,@b2b);
               for i:=0 to 7 do
                   begin
                   pole2d[sx*8+i,y]:=b2b[i];
                   end;
               end;

       i:=0;
       for y:=0 to znaky256[a].vyska-1 do
           begin
           for x:=0 to znaky256[a].sirka-1 do
               begin
               pole1d[i]:=pole2d[x,y];
               inc(i);
               end;
           end;
       end;

    if znaky256[a].dp>0 then
       begin
       Move(pole1d,znaky256[a].data^,znaky256[a].dp);
       znaky256[a].Komprimuj;
       end
       else begin   {nedefinovany znak}
       Znaky256[a].Done;
       dec(pocetzn);
       if a=first then inc(first);
       if a=last then dec(last);
       end;
    end;

if pocetzn=0 then begin first:=0;last:=0;end;

FreeMem(buf);
Load_FNT:=true;
end;


Function TFontFNT.VyskaRadky:byte;
begin
VyskaRadky:=so+su;
end;


Function TFontFNT.VratVelikost:byte;
begin
VratVelikost:=vel;
end;


Destructor TFontFNT.Done;
begin
inherited Done;
end;


Function Load_FNT_font_internal(s:string;poz,vels:longint):pointer;
var a,b:byte;
    grp:TGrpStream;
    n:string;
    l:longint;
    ok:boolean;
    pf:PFontFNT;
    hf:PObecnyFont;

begin
pf:=New(PFontFNT,Init);
pf^.rez:=NazevBezCesty(s);
{if vnm_fn_dbg>0 then
   a:=a;}  {/debug}
ok:=pf^.Load_FNT(s,poz,vels);
if ok=false then begin Dispose(pf,Done);Exit(nil);end;

hf:=New(PObecnyFont,Init);
hf^.fdata:=pf;
pf^.rukojet:=hf;
hf^.typzdroje:=2;
{0 = nevyplneno/neznamo
 1 = VGA
 2 = samostatne nacteno (nikoliv v kontejneru)
 3 = bitmapovy kontejner (napr. GRP soubor)
 4 = vektorovy kontejner
}
Load_FNT_font_internal:=hf;
end;



Function Load_FNT_font(s:string;size:longint):pointer;
begin
Load_FNT_font:=Load_FNT_font_internal(s,0,0);
end;


Function Load_FNT_font_z_FON(s:string;kde,vels:longint):pointer;
begin
Load_FNT_font_z_FON:=Load_FNT_font_internal(s,kde,vels);
end;



Function FNT_font_setstyle(fnt:pointer;podfunkce,param1,param2:longint):pointer;
var hf:PObecnyFont;
    n,m:byte;
begin
hf:=fnt;
if podfunkce=2 then
   if (param1 and prop_fn)<>0
      then VNMFN_PROP_MODE:=true
      else VNMFN_PROP_MODE:=false;
FNT_font_setstyle:=hf;
end;


Function FNT_Font_PrepChar(fnt:pointer;znak:word):pointer;
var hf:PObecnyFont;
begin
hf:=fnt;
FNT_Font_PrepChar:=hf^.FData^.PrepChar(znak);
end;



Procedure FNT_font_OutText(kam:pointer;x,y:longint;s:string;fnt:pointer;color:word);
var hf:PObecnyFont;
    pf:PFontFNT;

begin
if fnt<>nil then
   begin
   hf:=fnt;
   pf:=PFontFNT(hf^.fdata);
   VnmFnHlp_OutText(kam,x,y,s,pf,color);
   end;
end;


Function FNT_Font_GetInfo(fnt:pointer;param1,param2:longint):longint;
var hf:PObecnyFont;
    i:longint;

begin
hf:=fnt;
i:=hf^.GetInfo(param1,param2);
FNT_Font_GetInfo:=i;
end;


Function FNT_Font_delete(fnt:pointer;mode:byte):boolean;
var hf:PObecnyFont;
begin
hf:=fnt;
Dispose(hf,Done);       {automaticky smaze i hf^.FData (ve formatu PFontFNT)}
FNT_Font_delete:=true;
end;


Procedure Register_FNT_Loader;
begin
RegisterFontEngine('FNT',
                   @Load_FNT_font,
                   @FNT_Font_PrepChar,
                   @FNT_Font_OutText,
                   @FNT_Font_setstyle,
                   @FNT_Font_GetInfo,
                   @FNT_Font_delete);

end;




begin
Register_FNT_Loader;
end.
