unit vnm_bdf;
{****************************************************************************}
{Unit VNM_BDF - it is a addon unit for graphics library VenomGFX.             }
{It brings a loader for .BDF unicode bitmap font file.                                }
{****************************************************************************}

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

type
PFontBDF = ^TFontBDF;
TFontBDF = 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_BDF_file(s:string):boolean;
Function VyskaRadky:byte;virtual;
Function VratVelikost:byte;virtual;
Function PocetDefinovanychZnaku:longint;
Function OdemkniBlok(a:longint):byte;
Procedure VclenZnak(z:PZnak;i:longint);
Function PrepChar(znak:longint):pointer;virtual;
Destructor Done;virtual;
end;


Function Zkontroluj_format_BDF(s:string):boolean;
Function Load_BDF_font(s:string;size:byte):pointer;

var global_BDF_loader_popisek:string;
const vnm_bdf_dbg:byte=0;

implementation
uses GrpFile,VenomGFX,VenomMng;

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

   last:word;
   reserved1:byte;
   public_vel:byte;
   nahore:word;
   dole:word;
   end;


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


Function TFontBDF.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 TFontBDF.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;


Procedure TFontBDF.VclenZnak(z:PZnak;i:longint);
var ablokdiv,ablokmod:longint;
begin
if (i>=0) and (i<=65535) then
   begin
   ablokdiv:=i div 256;
   ablokmod:=i mod 256;
   OdemkniBlok(ablokdiv);
   ZBlok[ablokdiv]^[ablokmod]:=z;
   end;
end;


Function TFontBDF.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 Mid (const S: string; B,E: longint): string;
{Vraci cast podretezce S pocinaje B-tym znakem a E-tym konce}
begin
Mid:=Copy(s,b,e-b+1);
end;

Function Text_v_uvozovkach(const t:string):string;
var i,j,k,l,lt:longint;
begin
lt:=Length(t);
i:=Pos('"',t);
if i=0 then
   begin
   i:=Pos(' ',t);
   if i=0 then begin Text_v_uvozovkach:='';Exit;end;
   j:=i;
   for j:=i to LT do
       if t[j]<>' ' then
          begin
          for k:=j to LT do
              if t[k]=' ' then begin Text_v_uvozovkach:=Mid(t,j,k-1);Exit;end;
          Text_v_uvozovkach:=Mid(t,j,LT);
          Exit;
          end;
   Text_v_uvozovkach:='';Exit;
   end
   else begin
   for j:=i+1 to LT do
       if t[j]='"' then begin Text_v_uvozovkach:=Mid(t,i+1,j-1);Exit;end;
   Text_v_uvozovkach:=Mid(t,i+1,LT);
   end;
end;


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


Procedure Vyseparuj_BBX(const t:string;var p1,p2,p3,p4:longint);
var a,b,ua:longint;
    r:boolean;
    s:string;
    u:array[1..4] of longint;

begin
r:=false;
s:='';
ua:=1;
for a:=4 to Length(t) do  {zaciname znak za "BBX"}
    begin
    if (t[a]=' ') then
       if r=true then  {uzavreni rozpracovaneho slova}
          begin
          u[ua]:=MyVal(s);
          inc(ua);
          r:=false;
          s:='';
          end else
       else begin s:=s+t[a];r:=true;end;
    end;

if s<>'' then u[ua]:=MyVal(s);

p1:=u[1];
p2:=u[2];
p3:=u[3];
p4:=u[4];
end;


Procedure Rozpakuj_Bitmap_data_do_bufferu(p:pointer;const t:string;sx:longint);
var
    u:array[0..255] of byte;
    v:array[0..7] of byte;
    bv:pbyte;
    a,b,lt:longint;
    s:string;

begin
bv:=@u;
a:=1;
lt:=length(t);
repeat
if a<lt
   then s:='$'+t[a]+t[a+1]
   else s:='$'+t[a];

b:=MyVal(s);
ZnakBuf_Expand(b,bv);
Move(bv^,bv^,8);
inc(bv,8);
inc(a,2);
until a>lt;
Move(u,p^,sx);
end;


Function TFontBDF.Load_BDF_file(s:string):boolean;
var grp:TGrpStream;
    t:string;
    p:pointer;
    z:PZnak;
    zp:pbyte;
    a,aa,l,b,c,d:longint;
    p1,p2,p3,p4:longint;
    minz,maxz:longint;
    dp,sirka:byte;
    maxs,sizeh:longint;
    {ablokdiv,ablokmod,}aznum:longint;
    aablokdiv:longint;
    konec:boolean;
    inchar,inbitmap:boolean;

begin
grp.Init(DoplnJmenoFontu(s),grpOpenRead);
if grp.status<>grpOK then Exit(false);
rez:=NazevBezCesty(s);
konec:=false;
inchar:=false;
inbitmap:=false;
a:=0;
z:=nil;
minz:=maxlongint;
maxz:=-1;
max_sirka_bitmapy:=-1;
repeat
inc(a);
t:=grp.ReadString+' ';
if grp.status<>grpOK then Break;

if Copy(t,1,8)='ENDFONT ' then Break;

if Copy(t,1,10)='STARTCHAR ' then
   begin
   aznum:=-1;
   inchar:=true;
   if z=nil then z:=New(PZnak,Init);  {inicializace dat. struktury znaku}
   Continue;
   end;

if Copy(t,1,8)='ENDCHAR ' then
   begin
   {writeln(aznum);}
   inchar:=false;
   inbitmap:=false;
   if (aznum>=0) and (aznum<=65535) then
      begin
      {ablokdiv:=aznum div 256;
      ablokmod:=aznum mod 256;
      OdemkniBlok(ablokdiv);}
      {if aznum=257 then
         a:=a;}
      z^.Komprimuj;
      {ZBlok[ablokdiv]^[ablokmod]:=z;}   {a prirazeni k fontu}
      VclenZnak(z,aznum);
      inc(pocetzn);
      if aznum<minz then minz:=aznum;
      if aznum>maxz then maxz:=aznum;
      end;
   z:=nil;

   {if aznum>128 then konec:=true;}

   Continue;
   end;

if inchar=false then
   begin
   if Copy(t,1,10)='FACE_NAME ' then global_BDF_loader_popisek:=Text_v_uvozovkach(t) else
   if Copy(t,1,12)='FONT_ASCENT ' then begin SO:=MyVal(Text_v_uvozovkach(t));SOSU:=SO+SU;end else
   if Copy(t,1,13)='FONT_DESCENT ' then begin SU:=MyVal(Text_v_uvozovkach(t));SOSU:=SO+SU;end else
   if Copy(t,1,5)='SIZE ' then vel:=MyVal(Text_v_uvozovkach(t));

   end;

if inchar=true then
   begin
   if inbitmap=false then
      begin
      if Copy(t,1,9)='ENCODING ' then aznum:=MyVal(Text_v_uvozovkach(t)) else
      if Copy(t,1,4)='BBX ' then
         begin
         Vyseparuj_BBX(t,p1,p2,p3,p4);
         z^.sirka:=p1;
         z^.vyska:=p2;
         z^.relx:=p3;
         z^.rely:=-(p2+p4);
         z^.shift:=p1;
         if z^.sirka>max_sirka_bitmapy then max_sirka_bitmapy:=z^.sirka;
         end else
      if Copy(t,1,7)='DWIDTH ' then z^.shift:=MyVal(Text_v_uvozovkach(t)) else
      if Copy(t,1,6)='BITMAP' then
         begin
         inbitmap:=true;
         z^.dp:=z^.sirka*z^.vyska;
         GetMem(z^.data,z^.dp);
         FillChar(z^.data^,z^.dp,0);
         zp:=z^.data;
         z^.ready:=2;
         end;
      end
      else begin  {Znak bude nacitat jako dekomprimovany}
      while t[length(t)]=' ' do dec(t[0]);
      if t<>'' then Rozpakuj_Bitmap_data_do_bufferu(zp,t,z^.sirka);
      inc(zp,{l}z^.sirka);
      end;
   end;

until konec=true;

grp.Done;
first:=minz;
last:=maxz;
Load_BDF_file:=true;
end;



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


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


Destructor TFontBDF.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_BDF_font(s:string;size:byte):pointer;
var a,b:byte;
    grp:TGrpStream;
    n:string;
    l:longint;
    ok:boolean;
    pf:PFontBDF;
    hf:PObecnyFont;

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

ok:=pf^.Load_BDF_file(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_BDF_font:=hf;
end;


Function Zkontroluj_format_BDF(s:string):boolean;
var grp:TGRPStream;
    t,u:string;
begin
grp.Init(DoplnJmenoFontu(s),grpOpenRead);
if grp.status<>grpOK then Exit(false);
t:=grp.ReadString;
grp.Done;
Zkontroluj_format_BDF:=false;
if Copy(t,1,10)='STARTFONT ' then
   begin
   u:=Text_v_uvozovkach(t);
   if (u='2.1') or (u='2.2') then Zkontroluj_format_BDF:=true;
   end;
end;


Function BDF_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;
BDF_font_setstyle:=hf;
end;


Function BDF_Font_PrepChar(fnt:pointer;znak:word):pointer;
var hf:PObecnyFont;
begin
hf:=fnt;
BDF_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 BDF_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:PFontBDF;
    z:PZnak;

begin
ds:=Length(s);
s:=s+#0;
p:=@s[1];
ox:=x;
cr:=false;
virt:=kam;
hf:=fnt;
pf:=PFontBDF(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:=BDF_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 BDF_Font_GetInfo(fnt:pointer;param1,param2:longint):longint;
var hf:PObecnyFont;
    i:longint;

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


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


Procedure Register_BDF_Loader;
begin
RegisterFontEngine('BDF',
                   @Load_BDF_font,
                   @BDF_Font_PrepChar,
                   @BDF_Font_OutText,
                   @BDF_Font_setstyle,
                   @BDF_Font_GetInfo,
                   @BDF_Font_delete);

end;




begin
Register_BDF_Loader;
end.
