unit vnm_fu;
{****************************************************************************}
{Unit VNM_FN - it is a addon unit for graphics library VenomGFX.             }
{It brings a loader for .FU unicode bitmap font file.                                }
{****************************************************************************}

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

type
PFontFU = ^TFontFU;
TFontFU = object(TBitmapovyFont)
{vnitrnijmeno:string[32];}

ZBlok:array[0..255] of PBlok256p;  { TBlok256p = ^array[0..255] of PZnak;}

{Font bude ulozen v blocich po 256 znacich. To nam umozni uspornou alokaci
 pameti pro fonty, ktere maji definovany jen maly pocet z 65535 moznych znaku.
 U kazdeho fontu budeme aktivovat blok pro znaky 0..255 a dal se uvidi...}

maxpred,maxza,maxnad,maxpod:shortint;

Constructor Init;
Function Load_FU(s:string):boolean;
Function VyskaRadky:byte;virtual;
Function VratVelikost:byte;virtual;
Function PocetDefinovanychZnaku:longint;
Function OdemkniBlok(a:longint):byte;
Function PrepChar(znak:longint):pointer;virtual;
Destructor Done;virtual;
end;


Function Load_FU_font(s:string;size:byte):pointer;

var global_fu_loader_popisek:string;
const vnm_fu_dbg:byte=0;

implementation
uses GrpFile,VenomGFX,VenomMng;


const

     unimagic:pchar = 'öaö'; {ve skutecnosti 4 bajty: 'öaö'#0 }

type
TUnifont_header = packed record
   magic:array[1..4] of char;
   first:word;
   version:byte;
   {prapuvodni byly 0 a 1, ted zde ma byt 2}
   flags:byte;
   {0.bit: 0 = soubor neobsahuje popisek}
   {       1 = soubor obsahuje popisek}

   last:word;
   sbunky:byte;     {sirka bunky pro neproporcionalni mod}
   public_vel:byte;
   nahore:word;
   dole:word;
   end;


Constructor TFontFU.Init;
var i:longint;
begin
inherited init;
unicode:=true;
kodova_stranka:=65535;
format:=FNFMT_FU;
vel:=0;
prop:=true;
{vnitrnijmeno:='';}
for i:=0 to 255 do ZBlok[i]:=nil;
end;


Function TFontFU.OdemkniBlok(a:longint):byte;
var b:longint;
begin
if (a<0) or (a>255) then Exit(0);
if ZBlok[a]=nil then
   begin
   New(ZBlok[a]);  {pamet pro pozadovany blok}
   for b:=0 to 255 do    {ted vynuluju vsecny znaky v bloku}
       ZBlok[a]^[b]:=nil;  {vynulovani ukazatele pro konkretni znak}
   OdemkniBlok:=2;
   end
   else OdemkniBlok:=1;
end;




Function TFontFU.PrepChar(znak:longint):pointer;
var zd,zm:longint;
begin
if (znak>$FFFF) or (znak<0) then Exit(nil);
zd:=znak div 256;
if ZBlok[zd]=nil then Exit(nil)
   else begin
   zm:=znak mod 256;
   PrepChar:=ZBlok[zd]^[zm];  {muze byt NIL nebo platny ukazatel}
   end;
end;



Function TFontFU.PocetDefinovanychZnaku:longint;
var a,b,c:longint;
    z:PZnak;
begin
a:=0;
for b:=0 to 255 do
    if ZBlok[b]<>nil then
       begin
       for c:=0 to 255 do
           begin
           z:=ZBlok[b]^[c];
           if z<>nil then
              if z^.ready<>0 then inc(a);
           end;
       end;
PocetDefinovanychZnaku:=a;
end;


Function TFontFU.Load_FU(s:string):boolean;
var grp:TGrpStream;
    p:pointer;
    z:PZnak;
    q,oq:pbyte;
    r:pchar;
    _w:^word;
    a,aa,l,b,c,d,dp,dpw:longint;
    u:TUnifont_header;
    sirka:byte;
    byloext:boolean;
    maxs,sizeh:longint;
    ablokdiv,ablokmod:longint;
    aablokdiv:longint;
    bajtu_expoz:byte;
    t:string;

begin
t:=DoplnJmenoFontu(s);
grp.Init(t,grpOpenRead);
if grp.status<>grpOK then Exit(false);
l:=grp.GetSize;
GetMem(p,l);
grp.Read(p^,l);
grp.Done;
q:=p;
r:=p;

if r^<>unimagic^ then Exit(false);

rez:=NazevBezCesty(s);

sizeh:=sizeof(TUnifont_header);
Move(q^,u,sizeh);
inc(q,sizeh);

bajtu_expoz:=3;
global_fu_loader_popisek:='';
if u.version>0 then
   begin
   if (u.flags and 1)<>0 then
      begin
      a:=IndexByte(q^,l-sizeh,0);
      if a<>0 then
         begin
         global_fu_loader_popisek[0]:=char(a);
         Move(q^,global_fu_loader_popisek[1],a);
         inc(q,a);
         end;
      inc(q);
      end;
   if u.version>1 then
      begin
      bajtu_expoz:=4;
      end;
   end;

{if vnm_fu_dbg>0 then
   a:=a;}

first:=u.first;
last:=u.last;
so:=u.nahore;
su:=u.dole;
sosu:=so+su;
add:=0;
if u.sbunky=0 then sbunky:=9 else sbunky:=u.sbunky;
if u.public_vel=0 then vel:=sosu else vel:=u.public_vel;
pocetzn:=0;
maxpred:=0;
maxza:=0;
maxnad:=-u.nahore;
maxpod:=u.dole;
maxs:=0;
a:=u.first;
ablokdiv:=a div 256;
ablokmod:=a mod 256;

OdemkniBlok(ablokdiv);   {odemkneme blok, kde bude ulozen 1.def. znak}

repeat
    if u.version>1 then
       begin
       _w:=pointer(q);
       dpw:=_w^;
       dp:=dpw and $3FFF;
       inc(q,2);
       end
       else begin
       dpw:=q^;
       dp:=dpw;
       inc(q);
       end;
    if dp=0 then   {nula - to znamena, ze bude nasledovat B nedefinovanych znaku}
       begin
       _w:=pointer(q);
       b:=_w^;
       inc(q,2);

       (*
       b:=0;         {je to tu nutne - b je 4bajty, ale nacitame do nej jen 2}
       move(q^,b,2);inc(q,2);
       *)
       if b=0 then b:=65536;{pokud je zde nula, tak neni definovan ani 1 znak}
       a:=a+b{-1};
       ablokdiv:=a div 256;
       ablokmod:=a mod 256;
       OdemkniBlok(ablokdiv);
       end
       else begin
       if (a=34) and (u.version=2) then
          b:=b;

       if a=32 then
          a:=a;

       {definice znaku}
       if ablokmod>=256 then {napred zkontrolujeme, zda predchozi znak nebyl}
          begin              {poslednim v 256b bloku a zda ted nezacit novy}
          inc(ablokdiv);
          ablokmod:=0;
          OdemkniBlok(ablokdiv);  {odemkneme novy blok}
          end;

       z:=New(PZnak,Init);  {inicializace dat. struktury znaku}
       ZBlok[ablokdiv]^[ablokmod]:=z;   {a prirazeni k fontu}

       sirka:=q^;inc(q);
       byloext:=false;
       if u.version<=1 then
          begin
          if sirka>127 then  {nastaveny nejvyssi bit znamena, ze budou nasledovat}
             begin           {dalsi 3 bajty prodrobneji popisujici pozicovani znaku}
             sirka:=sirka and 127;  {vynulovani nejvyssiho bitu}
             z^.relx:=shortint(q^);inc(q);
             z^.rely:=shortint(q^);inc(q);
             z^.shift:=shortint(q^);inc(q);
             byloext:=true;
             end;
          end
          else begin  {version>=2}
          dpw:=dpw shr 14;
          dec(dp);
          if dpw>0 then
             begin
             if dpw<>1 then begin z^.korX_np:=shortint(q^);inc(q);end;
             if dpw<>2 then
                begin
                z^.relx:=shortint(q^);inc(q);
                z^.rely:=shortint(q^);inc(q);
                z^.shift:=shortint(q^);inc(q);
                byloext:=true;
                end;
             end;

          end;

       if byloext=false then
             begin
             z^.relx:=0;
             z^.rely:=-u.nahore;
             z^.shift:=sirka+2;
             byloext:=true;
             end;

       z^.sirka:=sirka;
       {z^.vyska:=u.nahore+u.dole;}
       z^.vyska:= dp*8 div sirka;

       {debug}{writeln('znak ',a,' : ',sirka,'shift :',z^.shift);readln;}  {/debug}


       if (z^.shift>sbunky+1) and (u.version>1) and (a<>32) then z^.bunek_np:=2;
       {v neproporcionalnim modu bude znak pres dve bunky ?}

       if sirka>maxs then maxs:=sirka;
       z^.dp:=dp;
       if dp>0
          then begin GetMem(z^.data,dp);Move(q^,z^.data^,dp);inc(q,dp);end
          else begin z^.data:=nil;z^.dp:=0;end;

       z^.ready:=2;
       if sirka>max_sirka_bitmapy then max_sirka_bitmapy:=sirka;
       inc(pocetzn);
       inc(a);
       inc(ablokmod);      {pozor - zde se muze stat, ze z 255 se stane 256}
                           {toto ale zkontrolujeme v dalsim cyklu}

       end;
until a>u.last;
maxza:=maxs;
FreeMem(p,l);

Load_FU:=true;
end;



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


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


Destructor TFontFU.Done;
var a,b:longint;
    z:PZnak;
begin
for a:=0 to 255 do
    if ZBlok[a]<>nil then
       begin
       for b:=0 to 255 do
           begin
           z:=ZBlok[a]^[b];
           if z<>nil then dispose(z,Done);
           end;
       Dispose(ZBlok[a]);
       ZBlok[a]:=nil;
       end;
inherited Done;
end;



Function Load_FU_font(s:string;size:byte):pointer;
var a,b:byte;
    grp:TGrpStream;
    n:string;
    l:longint;
    ok:boolean;
    pf:PFontFU;
    hf:PObecnyFont;

begin
pf:=New(PFontFU,Init);
pf^.rez:=NazevBezCesty(s);

ok:=pf^.Load_FU(s);
if ok=false then begin Dispose(pf,Done);Exit(nil);end;

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


Function FU_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;
FU_font_setstyle:=hf;
end;


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



Function UTF82longint(s:pchar;delka,poz:longint;var posun:byte):longint;assembler;
asm
dec poz
mov edi,posun
mov esi,s
add esi,poz

movzx eax,byte [esi]
cmp al,128
jae @vetsi_nebo_rovno128
    {jednobajtovy}
    mov bl,1
    mov [edi],bl   {posun:=1}
    movzx eax,al
    jmp @konec
@vetsi_nebo_rovno128:

cmp al,240
jae @vetsi_nebo_rovno240

cmp al,224
jae @vetsi_nebo_rovno224
    {dvojbajtovy}
    mov bl,2
    mov [edi],bl
    mov ecx,poz
    inc ecx
    cmp ecx,delka
    jbe @neni_vetsi_nez_delka
    mov eax,63       {UTF82word:=63 (znak ?) - ochrana pred nekorektnimi daty}
    jmp @konec
@neni_vetsi_nez_delka:
    and eax,63
    shl eax,6
    inc esi
    mov bl,[esi]
    and bl,63
    add al,bl
    jmp @konec

@vetsi_nebo_rovno224:
    {trojbajtovy}
    mov bl,3
    mov [edi],bl
    mov ecx,poz
    add ecx,2
    cmp ecx,delka
    jbe @neni_vetsi_nez_delka2
    mov eax,21       {UTF82word:=21 (znak ) - ochrana pred nekorektnimi daty}
    jmp @konec
@neni_vetsi_nez_delka2:
    and eax,15
    shl eax,12
    inc esi
    movzx ebx,byte [esi]
    and ebx,63
    shl ebx,6
    add eax,ebx
    inc esi
    mov bl,[esi]
    and bl,63
    add al,bl
    jmp @konec

@vetsi_nebo_rovno240:
    {ctyrbajtovy}
    mov bl,4
    mov [edi],bl
    mov ecx,poz
    add ecx,3
    cmp ecx,delka
    jbe @neni_vetsi_nez_delka3
    mov eax,126       {UTF82word:=126 (znak ~) - ochrana pred nekorektnimi daty}
    jmp @konec
@neni_vetsi_nez_delka3:
    and eax,7
    shl eax,18
    inc esi
    movzx ebx,byte [esi]
    and ebx,63
    shl ebx,12
    add eax,ebx
    inc esi
    movzx ebx,byte [esi]
    and ebx,63
    shl ebx,6
    add eax,ebx
    inc esi
    movzx ebx,byte [esi]
    and ebx,63
    add eax,ebx

@konec:
end;




Procedure FU_font_OutText(kam:pointer;x,y:longint;s:string;fnt:pointer;color:word);
{Pracujeme s Unicode fontem. Vstupni retezec ocekava v kodovani UTF-8}
var i,ds,e,ox:longint;
    p:pchar;
    c:char;
    ii:byte;
    cr:boolean;
    virt:PVirtualWindow;
    hf:PObecnyFont;
    pf:PFontFU;
    z:PZnak;

begin
ds:=Length(s);
s:=s+#0;
p:=@s[1];
ox:=x;
cr:=false;
virt:=kam;
hf:=fnt;
pf:=PFontFU(hf^.fdata);


i:=1;
while i<=ds do
   begin
   e:=UTF82longint(p,ds,i,ii);
   inc(i,ii);
   if e=13 then
      begin
      x:=ox;
      inc(y,pf^.VyskaRadky);
      cr:=true;
      end
      else
   if (e=10) and (cr=true) then cr:=false
      else
      begin
      z:=FU_Font_PrepChar(fnt,e);
      if z<>nil then
         begin
         PutChar_FN(virt^,
                    z^.data,
                    x+z^.relX,
                    y+z^.relY,
                    z^.sirka,
                    z^.vyska,
                    z^.dp,
                    color);
         inc(x,z^.shift);
         end;
      cr:=false;
      end;
   end;
end;


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

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


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


Procedure Register_FU_Loader;
begin
RegisterFontEngine('FU',
                   @Load_FU_font,
                   @FU_Font_PrepChar,
                   @FU_Font_OutText,
                   @FU_Font_setstyle,
                   @FU_Font_GetInfo,
                   @FU_Font_delete);

end;




begin
Register_FU_Loader;
end.
