unit vnm_fn;
{****************************************************************************}
{Unit VNM_FN - it is a addon unit for graphics library VenomGFX.             }
{It brings a loader for .FN bitmap font file.                                }
{  Supports files with single-sized font                                     }
{  However also supports multi-sized archives with more .FN files            }
{  (internaly .GRP format but renamed into .FN extension)                    }
{****************************************************************************}

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

implementation
uses GrpFile,VenomGFX,VenomMng,VnmFnHlp;


const
     fnmagic = 'ëmÕonç ';

type
     PFontFN = ^TFontFN;
     TFontFN = object(TZnaky256)
     mapa:TGrpMapa;
     rez:string[12];
     vnitrnijmeno:string[32];
     maxpred,maxza,maxnad,maxpod:shortint;
     add:shortint;

     Constructor Init;
     Procedure Load_single_FN(s:string);
     Procedure SmazAktualniSadu;
     Function VyskaRadky:byte;
     Function VratVelikost:byte;
     Destructor Done;virtual;
     end;


Constructor TFontFN.Init;
begin
first:=0;
last:=0;
vel:=0;
prop:=true;
vnitrnijmeno:='';
mapa.num:=0;
mapa.__vel:=0;
end;


Procedure TFontFN.Load_single_FN(s:string);
var grp:TGrpStream;
    a,b,c,l,v,w:longint;
    z2,z3,t:^byte;
    n,m,oo:word;
    mgl:byte;
    p:pchar;
    pracbuf:array[0..4095] of byte;
    z:pointer;

begin
grp.Init(NormalizujJmenoFontu(s),grpOpenRead);
mgl:=Length(fnmagic);
grp.Seek(mgl);                 {zahlavi uz mame zkontrolovane, takze preskocim}
l:=grp.GetSize-mgl;

GetMem(p,l);             {pripravim si pamet}
grp.ReadStream(p^,l);    {nahraju o ni zbytek souboru}
grp.Done;                {ted uz muzu soubor zavrit}

a:=IndexByte(p^,l,0);    {kde v bufferu je prvni ASCII 0 ?}
if a<>0 then
   begin
   vnitrnijmeno[0]:=char(a);
   Move(p^,vnitrnijmeno[1],a);    {predani vnitrniho nazvu fontu}
   end;

maxpred     :=127;
maxza       :=-127;
maxnad      :=127;
maxpod      :=-127;

first:=byte(p[a+1]);
last:=byte(p[a+2]);

so:=shortint(p[a+3]);
su:=shortint(p[a+4]);
add:=shortint(p[a+5]);

if p[a+6]<>#0 then
   begin
   {Tento bajt se nazyva Future, musi byt 0. Prislusne chybove osetreni
    zatim neimplementovano}
   end;

z:=@pracbuf;
for b:=0 to 255 do Znaky256[b].Init;

for b:=first to last do
    begin
    c:=(b-first)*7+a+mgl;
    znaky256[b].relx:=shortint(p[c+0]);
    znaky256[b].rely:=shortint(p[c+1]);
    znaky256[b].sirka:=byte(p[c+2]);
    znaky256[b].vyska:=byte(p[c+3]);
    znaky256[b].shift:=shortint(p[c+4]);

    v:=znaky256[b].sirka*znaky256[b].vyska; {pocet bodu, ze kterych znak je}
    if v>0 then
       begin
       GetMem(znaky256[b].data,v); {alokuje bitmapu}
       w:=longint(p[c+5])+longint(p[c+6])*256;

       n:=(znaky256[b].sirka+7) div 8;
       t:=znaky256[b].data;     { zapisovaci pointer nastavi na bitmapu }
       for oo:=0 to znaky256[b].vyska-1 do
           begin
           z2:=z;
           for m:=0 to n-1 do
               begin
               ZnakBuf_Expand(byte(p[w-mgl+oo*n+m]),z2);
               inc(z2,8);
               end;
           Move(z^,t^,znaky256[b].sirka);
           inc(t,znaky256[b].sirka);
           end;

      {znak jsme dekomprimovali, ale ted ho prekvapive budu znovu komprimovat}
      {predchozi komprese totiz pakovala jednotlive radky zvlast, kdezto ja
      zapakuju celou bitmapu vcelku}
      znaky256[b].Komprimuj;
      end else znaky256[b].data:=nil; { if V>0 }

      with znaky256[b] do
         begin
         if relX<maxpred       then maxpred :=relX;
         if relY<maxnad        then maxnad  :=relY;
         if relX+sirka-1>maxza  then maxza   :=relX+sirka-1;
         if relY+vyska-1>maxpod then maxpod  :=relY+vyska-1;
         end;{with}
      end; {for}

system.FreeMem(p,l);
end;


Procedure TFontFN.SmazAktualniSadu;
begin
inherited Done;
end;


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


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


Destructor TFontFN.Done;
begin
mapa.Done;
SmazAktualniSadu;
end;


Function Nejblizsi_velikost_dle_mapy(pf:PFontFN;n:byte):byte;
var a:byte;
begin
if pf^.mapa.num=0 then Exit(0);
if pf^.mapa.num=1 then Exit(1);
if n<=pf^.mapa.zaznam^[1].oznaceni then Exit(1);
if n>=pf^.mapa.zaznam^[pf^.mapa.num].oznaceni then Exit(pf^.mapa.num);

a:=1;
while n>pf^.mapa.zaznam^[a].oznaceni do inc(a);

if n-pf^.mapa.zaznam^[a-1].oznaceni<pf^.mapa.zaznam^[a].oznaceni-n
   then Nejblizsi_velikost_dle_mapy:=a-1
   else Nejblizsi_velikost_dle_mapy:=a;
end;


Procedure ZkontrolujVlozeneFN(s:string;var mp:TgrpMapa);
var g:TGrpStream;
    n:string;
    a:byte;
begin
a:=1;
repeat
    g.Init(NormalizujJmenoFontu(s)+'#'+mp.zaznam^[a].nazev,grpOpenRead);
    n[0]:=#7;
    g.Read(n[1],7);
    g.Done;
    if n<>fnmagic then
       begin
       if a<mp.num then
          begin
          mp.zaznam^[a].nazev:=mp.zaznam^[a+1].nazev;
          mp.zaznam^[a].oznaceni:=mp.zaznam^[a+1].oznaceni;
          end;
       dec(mp.num);
       end
       else inc(a);
until a>mp.num;
end;


Function Load_FN_font(s:string;size:byte):pointer;
var a,b:byte;
    grp:TGrpStream;
    n:string;
    pf:PFontFN;
    prac:TGrpMapa;

begin
grp.Init(NormalizujJmenoFontu(s),grpOpenRead);
if grp.status<>grpOK then Exit(nil);

if grp.Jsem_ja_grp=true then  {multi FN?}
   begin
   grp.Jak_ja_obsahuju_cislovane_soubory(prac);
   ZkontrolujVlozeneFN(s,prac);
   grp.Done;
   if prac.num=0 then  {vsechny vlozene soubory jsou nevyhovujici?}
      begin
      prac.Done;
      Exit(nil);
      end;
   b:=prac.num;
   end
   else begin                 {single FN?}
   n[0]:=#7;
   grp.Read(n[1],7);
   grp.Done;
   if n<>fnmagic then Exit(nil);

   b:=0;          {nejde o multi FN}
   end;

pf:=New(PFontFN,Init);
pf^.rez:=s;
pf^.mapa.Init(b);
if b>0 then
   begin
   for a:=1 to b do
       begin
       pf^.mapa.zaznam^[a].nazev:=prac.zaznam^[a].nazev;
       pf^.mapa.zaznam^[a].oznaceni:=prac.zaznam^[a].oznaceni;
       end;
   prac.Done;
   end;
Load_FN_font:=pf;
end;


Procedure FN_font_setstyle(fnt:pointer;size,flags:byte);
var pf:PFontFN;
    n,m:byte;
begin
pf:=fnt;
n:=Nejblizsi_Velikost_dle_mapy(pf,size);

if pf^.vel=0 then   {jeste neni nactena zadna sada?}
   begin
   if n=0 then begin
          pf^.Load_single_FN(pf^.rez);
          pf^.vel:=pf^.VyskaRadky;
          end
          else begin
          pf^.Load_single_FN(pf^.rez+'#'+pf^.mapa.zaznam^[n].nazev);
          pf^.vel:=pf^.mapa.zaznam^[n].oznaceni;
          end;
   end
   else begin       {nejaka sada uz nactena je...}
   if n=0 then begin end {jen jedna def. velikost, dalsi rozbor nema smysl}
          else begin
          m:=pf^.mapa.zaznam^[n].oznaceni;
          if m<>pf^.vel then
             begin
             pf^.SmazAktualniSadu;
             pf^.Load_single_FN(pf^.rez+'#'+pf^.mapa.zaznam^[n].nazev);
             pf^.vel:=m;
             end;
          end;
   end;
end;


Function FN_Font_PrepChar(fnt:pointer;znak:word):pointer;
begin
FN_Font_PrepChar:=PFontFN(fnt)^.PrepChar(znak);
end;


Procedure FN_font_OutText(kam:pointer;x,y:longint;s:string;fnt:pointer;color:word);
var i,ox:longint;
    c:char;
    cr:boolean;
    virt:PVirtualWindow;
    pf:PFontFN;
    z:PZnak;

begin
ox:=x;
cr:=false;
virt:=kam;
pf:=fnt;
for i:=1 to Length(s) do
    begin
    c:=s[i];
    if c=#13 then
       begin
       x:=ox;
       inc(y,pf^.VyskaRadky);
       cr:=true;
       end
       else
    if (c=#10) and (cr=true) then cr:=false
       else
       begin
       z:=FN_Font_PrepChar(fnt,byte(c));
       {@pf^.znaky256[byte(c)];}
       PutChar_FN(virt^,
                  z^.data,
                  x+z^.relX,
                  y+z^.relY,
                  z^.sirka,
                  z^.vyska,
                  z^.dp,
                  color);
       inc(x,z^.shift+pf^.add);
       cr:=false;
       end;
    end;
end;


Function FN_Font_GetInfo(fnt:pointer;param:longint):longint;
var pf:PFontFN;
begin
pf:=fnt;
case param of
1:{velikost}
  FN_Font_GetInfo:=pf^.VratVelikost;
else FN_Font_GetInfo:=0;
end; {case}
end;


Procedure FN_Font_delete(fnt:pointer);
var fn:PFontFN;
begin
fn:=fnt;
Dispose(fn,Done);
end;


Procedure Register_FN_Loader;
begin
RegisterFontEngine('FN',
                   @Load_FN_font,
                   @FN_Font_PrepChar,
                   @FN_Font_OutText,
                   @FN_Font_setstyle,
                   @FN_Font_GetInfo,
                   @FN_Font_delete);

end;




begin
Register_FN_Loader;
end.
