unit vnm_fv;
{****************************************************************************}
{Unit VNM_FV - it is a addon unit for graphics library VenomGFX.             }
{It brings a loader for plain VGA charset file (use extension .FV for them)  }
{  Supports files with single-sized font (usually sized 4096, 2048 or 3584   }
{  bytes).                                                                   }
{****************************************************************************}
{$IFDEF VER2}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF VER3}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF NEWFPC}{$CALLING OLDFPCCALL}{$ENDIF}
interface
uses Objects,VnmFnHlp;

const
MAX_FV_CHARSET_HIGH = 32;
VNM_FV_NACITEJ_JAKO_PROPORCNI:boolean = true;

type

TVGAcharset = packed array[0..255,1..MAX_FV_CHARSET_HIGH] of Byte;
   {ulozeni znaku z VGA}
PVGACharset = ^TVGACharset;


PFontFV = ^TFontFV;
TFontFV = object(TBitMapZnaky256)
Constructor Init;
{function Load_FV_data(s:string;pozf,velf:longint):boolean;}
Function Load_FV_data({s:string}var grp:Pstream;pozf,velf:longint):boolean;
Function Load_FV_file(s:string):boolean;
Function Load_FV_from_container(s:string;pozf,velikost:longint):boolean;
Function Load_FV_from_PVGACharset_buffer(p:PVGACharset;velikost:word):boolean;
Procedure NastavVelikostExt(velikost,porce_su:word);virtual;
Function Z_PVGAcharset_desifruj_su(p:PVGAcharset;velikost:byte):byte;
Function PrepChar(znak:longint):pointer;virtual;
Destructor Done;virtual;
end;

Function Zkontroluj_Format_FV(s:string):boolean;
Function Zkontroluj_Format_FV_a_dej_velikost(s:string;var vel:longint):boolean;
Function Load_FV_font(s:string;size:longint):pointer; {realne PObecnyFont}
Function Load_FV_font_from_stream(var g:PStream;var s:string;size:longint):pointer; {realne PObecnyFont}
Function Load_FV_font_from_stream_se_spec_pozici(var g:PStream;var s:string;pozice,size:longint):pointer; {realne PObecnyFont}
Function Load_FV_font_from_container(s:string;pozf,size:longint):pointer; {realne PObecnyFont}


implementation
uses GrpFile,GrpUtil,VenomMng;


Constructor TFontFV.Init;
begin
inherited Init(0);
sbunky:=9;
format:=FNFMT_FV;
end;


Procedure TFontFV.NastavVelikostExt(velikost,porce_su:word);
{nastavi jen udaje o vysce. Udaje samotnych znaku nijak nemeni, natoz aby
 nejak modofikoval jednotlive bitmapy}
begin
if porce_su=0 then
   if velikost=0 then su:=0 else
      if velikost=16 then su:=3 else
         if velikost=14 then su:=2 else
            if velikost=8 then su:=1 else su:=vel div 8 + 1;
inherited NastavVelikostExt(velikost,porce_su);
end;



Function TFontFV.Z_PVGAcharset_desifruj_su(p:PVGAcharset;velikost:byte):byte;
{Obrazova analyza znaku "." Snazime se zjistit, kde ve fontu je zakladni linka}
var r:pchar;
    a,b,d:byte;
begin
b:=byte('.');
for d:=velikost downto 1 do
    begin
    a:=p^[b,d];
    if a<>0 then
       Exit(velikost-d);
    end;
Z_PVGAcharset_desifruj_su:=0;
end;



Function Analyzuj7_bit(tempvga:PVGAcharset;velikost:byte):boolean;
{Zanalyzuje VGA font, jestli pro definici znaku pismen vyuziva i 7.bit.
 Pokud totiz ano, tak neni bezpecne provadet zrcadleni 7.bitu do 8.bitu pro
 znaky $B0 az $DF.
 Tedy: TRUE  - 7.bit je obsazovan
       FALSE - 7.bit neni obsazovan
}

var a:longint;
    z:PZnak;
    p:pchar;
begin
{z:=PrepChar(byte('M'));
p:=z^.data;}

for a:=1 to velikost do
    if odd(tempvga^[byte('M'),a]) then Exit(true);

Analyzuj7_bit:=false;
end;


Procedure Pridej_9_bit(tempvga:PVGAcharset; vgakonv:pointer{realne PBitMapZnaky256}; vyska:byte);
var a:byte;
    p:pchar;
    vgakonvT:PBitMapZnaky256;
    bit7:boolean;


begin


{bit7:=Analyzuj7_bit(tempvga,vyska);}  {zatim nepouzivame}

{Zanalyzuje VGA font, jestli pro definici znaku pismen vyuziva i 7.bit.
 Pokud totiz ano, tak neni bezpecne provadet zrcadleni 7.bitu do 8.bitu pro
 znaky $B0 az $DF.
 Tedy: TRUE  - 7.bit je obsazovan
       FALSE - 7.bit neni obsazovan
}


p:=pointer(tempvga);
vgakonvT:=vgakonv;
for a:=0 to 255 do
    begin
    vgakonvT^.znaky256[a].init;
    vgakonvT^.znaky256[a].LoadCompressedData(p,vyska,8,vyska);

    {if vyska=19 then vgakonv^.znaky256[a].Dekomprimuj(a,true,false)
       else}
    if (a>$b9) and (a<$e0)
    {musime vyresit 8. bit - u znaku $C0 az $DF se do 8. bitu kopiruje 7.}
    {u ostatnich je prazdny }
       then vgakonvT^.znaky256[a].Dekomprimuj(true,true)
       else vgakonvT^.znaky256[a].Dekomprimuj(true,false);

    vgakonvT^.znaky256[a].shift:=9;
    vgakonvT^.znaky256[a].Komprimuj;
    if vgakonvT^.znaky256[a].sirka>vgakonvT^.max_sirka_bitmapy
       then vgakonvT^.max_sirka_bitmapy:=vgakonvT^.znaky256[a].sirka;
    inc(p,MAX_FV_CHARSET_HIGH);
    end;
end;


Procedure Bez_pridani_9_bitu(tempvga:PVGAcharset; vgakonv:pointer{realne PBitMapZnaky256}; vyska:byte);
var a:byte;
    p:pchar;
    vgakonvT:PBitMapZnaky256;

begin
p:=pointer(tempvga);
vgakonvT:=vgakonv;
vgakonvT^.max_sirka_bitmapy:=8;
for a:=0 to 255 do
    begin
    vgakonvT^.znaky256[a].init;
    vgakonvT^.znaky256[a].LoadCompressedData(p,vyska,8,vyska);
    inc(p,MAX_FV_CHARSET_HIGH);
    end;
end;



Function Zkontroluj_Format_FV_a_dej_velikost(s:string;var vel:longint):boolean;
var grp:TGrpStream;
    i:longint;

begin
grp.Init(DoplnJmenoFontu(s),grpOpenRead);
if grp.status<>grpOK then begin vel:=0;Exit(false);end;
i:=grp.GetSize;
if (i<6*256) or (i>MAX_FV_CHARSET_HIGH*256) then begin vel:=0;grp.Done;Exit(false);end;
if i mod 256 = 0 then
   begin
   vel:=i div 256;
   Zkontroluj_Format_FV_a_dej_velikost:=true;
   end
   else begin
   vel:=0;
   Zkontroluj_Format_FV_a_dej_velikost:=false;
   end;
end;


Function Zkontroluj_Format_FV(s:string):boolean;
var i:longint;
begin
Zkontroluj_Format_FV:=Zkontroluj_Format_FV_a_dej_velikost(s,i);
end;


Function TFontFV.Load_FV_data(var grp:pstream;pozf,velf:longint):boolean;
{GRP je jiz otevreny Stream}
var dgrp:TGrpStream;
    a,l,v,dsu:longint;
    okvelikost,zrdc:boolean;
    t:TVGAcharset;
    orig_neprop:PBitMapZnaky256;

begin
if pozf=0 then
   begin
   l:=grp^.GetSize;
   okvelikost:=(l>=6*256) and (l<=MAX_FV_CHARSET_HIGH*256) and (l mod 256 = 0);
   if not okvelikost then
      begin Exit(false);end;
   grp^.Seek(pozf);
   end
   else begin
   l:=velf;
   if pozf<0 then pozf:=0;
   grp^.Seek(pozf);
   end;

v:=l div 256;            {kolik bajtu, tzn. radku ma kazdy znak}
for a:=0 to 255 do
    grp^.Read(t[a,1],v);

orig_neprop:=New(PBitMapZnaky256,Init(v));
orig_neprop^.NastavVelikost(v);

for a:=0 to 255 do
    begin
    orig_neprop^.znaky256[a].ready:=2;
    orig_neprop^.znaky256[a].rely:=-so;
    end;


dsu:=Z_PVGAcharset_desifruj_su(@t,v);
NastavVelikostExt(v,dsu);


if VNM_FV_NACITEJ_JAKO_PROPORCNI=true
   then begin
   Pridej_9_bit(@t, orig_neprop, v);
   Preved_Font_na_proporcni(@self,orig_neprop,v);
   {z neproporcniho fontu vyrobim proporcni font}
   Dispose(orig_neprop,Done);
   end
   else begin
   Bez_pridani_9_bitu(@t, orig_neprop, v);
   Preved_Font_bez_konverze_na_proporcni(@self,orig_neprop,v);
   Dispose(orig_neprop,Done);
   end;

Load_FV_data:=true;
end;


Function TFontFV.Load_FV_file(s:string):boolean;
var grp:PGrpStream;
begin
grp:=New(PGrpStream,Init(DoplnJmenoFontu(s),grpOpenRead));
if grp^.status<>grpOK then begin Dispose(grp,Done);Exit(false);end;
Load_FV_file:=Load_FV_data(grp,0,0);
Dispose(grp,Done);
end;


Function TFontFV.Load_FV_from_container(s:string;pozf,velikost:longint):boolean;
var grp:PGrpStream;
begin
{writeln(s);
writeln(DoplnJmenoFontu(s));
writeln('('+ADRESAR_S_FONTY+')');}
{writeln(okvelikost);
writeln(okindex);}
{readln;}
grp:=New(PGrpStream,Init(DoplnJmenoFontu(s),grpOpenRead));
if grp^.status<>grpOK then begin Dispose(grp,Done);Exit(false);end;
Load_FV_from_container:=Load_FV_data(grp,pozf,velikost*256);
Dispose(grp,Done);
end;



Function TFontFV.Load_FV_from_PVGACharset_buffer(p:PVGACharset;velikost:word):boolean;
var t:TVGACharset;
    a,dsu:longint;
    orig_neprop:PBitMapZnaky256;

begin
if p=nil then Exit(false);

orig_neprop:=New(PBitMapZnaky256,Init(velikost));
orig_neprop^.NastavVelikost(velikost);

for a:=0 to 255 do
    begin
    orig_neprop^.znaky256[a].ready:=2;
    orig_neprop^.znaky256[a].rely:=-so;
    end;

dsu:=Z_PVGAcharset_desifruj_su(p,velikost);
NastavVelikostExt(velikost,dsu);
Pridej_9_bit(p, orig_neprop, velikost);

{if velikost=16 then
   begin
   a:=a;
   end;}

Preved_Font_na_proporcni(@self,orig_neprop,velikost);
{z neproporcniho fontu vyrobim proporcni font}

Dispose(orig_neprop,Done);

Load_FV_from_PVGACharset_buffer:=true;
end;


Function TFontFV.PrepChar(znak:longint):pointer;
begin
PrepChar:=inherited PrepChar(znak);
end;


Destructor TFontFV.Done;
begin
inherited Done;
end;


Function FV_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;
FV_font_setstyle:=hf;
end;


Function Dotvoreni_struktury_po_Load_FV(pf:PFontFV):PObecnyFont;
var hf:PObecnyFont;
begin
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
}
Dotvoreni_struktury_po_Load_FV:=hf;
end;



Function Load_FV_font_internal(s:string;pozf,size:longint):pointer; {realne PObecnyFont}
var ok:boolean;
    pf:PFontFV;
    s2:string;

begin
pf:=New(PFontFV,Init);
s2:=NazevBezCesty(s);
pf^.rez:=NazevBezCesty(s);
ok:=pf^.Load_FV_from_container(s,pozf,size);
if ok=false then begin Dispose(pf,Done);Exit(nil);end;

Load_FV_font_internal:=Dotvoreni_struktury_po_Load_FV(pf);
end;


Function Load_FV_font(s:string;size:longint):pointer; {realne PObecnyFont}
begin
Load_FV_font:=Load_FV_font_internal(s,0,size);
end;

Function Load_FV_font_from_container(s:string;pozf,size:longint):pointer; {realne PObecnyFont}
begin
Load_FV_font_from_container:=Load_FV_font_internal(s,pozf,size);
end;


Function Load_FV_font_from_stream_se_spec_pozici(var g:PStream;var s:string;pozice,size:longint):pointer; {realne PObecnyFont}
var pf:PFontFV;
    ok:boolean;
begin
pf:=New(PFontFV,Init);
pf^.rez:=NazevBezCesty(s);
ok:=pf^.Load_FV_data(g,pozice,size*256);
if ok=false then begin Dispose(pf,Done);Exit(nil);end;
Load_FV_font_from_stream_se_spec_pozici:=Dotvoreni_struktury_po_Load_FV(pf);
end;


Function Load_FV_font_from_stream(var g:PStream;var s:string;size:longint):pointer; {realne PObecnyFont}
begin
Load_FV_font_from_stream:=Load_FV_font_from_stream_se_spec_pozici(g,s,-1,size);  {realne PObecnyFont}
end;


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


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

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



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

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


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



Procedure Register_FV_Loader;
begin
RegisterFontEngine('FV',
                   @Load_FV_font,
                   @FV_Font_PrepChar,
                   @FV_Font_OutText,
                   @FV_Font_setstyle,
                   @FV_Font_GetInfo,
                   @FV_Font_delete);

end;




begin
Register_FV_Loader;
end.
