unit vnm_vga;
{****************************************************************************}
{Unit VNM_VGA - it is a addon unit for graphics library VenomGFX.            }
{It brings a loader for plain VGA charset file (use extension .VGA for them) }
{  Supports files with single-sized font (usually sized 4096, 2048 or 3584   }
{  bytes). However also supports multi-sized archives with more .VGA files   }
{  (internaly .GRP format but renamed into .VGA extension)                   }
{****************************************************************************}
{$IFDEF VER2}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF VER3}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF NEWFPC}{$CALLING OLDFPCCALL}{$ENDIF}
interface

implementation
uses GrpFile,VenomGFX,VenomMng,VnmFnHlp;

type
     PFontVGA = ^TFontVGA;
     TFontVGA = object
     mapa:TGrpMapa;
     rez:string[12];

     vel:byte;
     propblok:TZnaky256;     {pro proporcionalni verzi}
     neprblok:TZnaky256;     {pro neproporcionalni verzi}
     aktblok:PZnaky256; {ukazuje bud na PROPBLOK nebo NEPRBLOK}


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


Constructor TFontVGA.Init;
begin
propblok.init(0);propblok.prop:=true;
neprblok.init(0);neprblok.prop:=false;
aktblok:=@neprblok;
mapa.num:=0;
mapa.__vel:=0;
vel:=0;
end;


Procedure TFontVGA.Load_single_VGA(s:string);
var grp:TGrpStream;
    a,l,v:longint;
    t:TVGAcharset;


begin
grp.Init(NormalizujJmenoFontu(s),grpOpenRead);
l:=grp.GetSize;
v:=l div 256;            {kolik bajtu, tzn. radku ma kazdy znak}

for a:=0 to 255 do
    grp.ReadStream(t[a,1],v);   {postupne nactu znak po znaku}
grp.Done;                {ted uz muzu soubor zavrit}

neprblok.NastavVelikost(v);
Pridej_9_bit(@t, @neprblok, v);
Preved_Font_na_proporcni(@propblok,@neprblok,v); {jeste proporcialni variantu}
end;


Procedure TFontVGA.SmazAktualniSadu;
begin
propblok.Done;
neprblok.Done;
end;


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


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


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


Function Nejblizsi_velikost_dle_mapy(pf:PFontVGA;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 ZkontrolujVlozeneVGA(s:string;var mp:TgrpMapa);
var g:TGrpStream;
    n:string;
    a:byte;
    l:longint;
    okvelikost:boolean;

begin
a:=1;
repeat
    g.Init(NormalizujJmenoFontu(s)+'#'+mp.zaznam^[a].nazev,grpOpenRead);
    l:=g.GetSize;
    okvelikost:=(l>=2048) and (l<=8192) and (l mod 256 = 0);
    g.Done;
    if not okvelikost 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_VGA_font(s:string;size:byte):pointer;
var a,b:byte;
    grp:TGrpStream;
    n:string;
    l:longint;
    okvelikost:boolean;
    pf:PFontVGA;
    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);
   ZkontrolujVlozeneVGA(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?}
   l:=grp.GetSize;
   okvelikost:=(l>=2048) and (l<=8192) and (l mod 256 = 0);
   grp.Done;
   if not okvelikost then Exit(nil);

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

pf:=New(PFontVGA,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_VGA_font:=pf;
end;



Procedure VGA_font_setstyle(fnt:pointer;size,flags:byte);
var pf:PFontVGA;
    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_VGA(pf^.rez);
          pf^.vel:=pf^.VyskaRadky;
          end
          else begin
          pf^.Load_single_VGA(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_VGA(pf^.rez+'#'+pf^.mapa.zaznam^[n].nazev);
             pf^.vel:=m;
             end;
          end;
   end;
if (flags and prop_fn)<>0 then pf^.aktblok:=@pf^.propblok else pf^.aktblok:=@pf^.neprblok;
end;


Function VGA_Font_PrepChar(fnt:pointer;znak:word):pointer;
var pf:PFontVGA;
begin
pf:=fnt;
VGA_Font_PrepChar:=pf^.AktBlok^.PrepChar(znak);
end;


Procedure VGA_font_OutText(kam:pointer;x,y:longint;s:string;fnt:pointer;color:word);
var i,ox:longint;
    c:char;
    cr:boolean;
    virt:PVirtualWindow;
    pf:PFontVGA;
    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:=VGA_Font_PrepChar(fnt,byte(c));
       PutChar_FN(virt^,
                  z^.data,
                  x+z^.relX,
                  y+z^.relY,
                  z^.sirka,
                  z^.vyska,
                  z^.dp,
                  color);
       inc(x,z^.shift);
       cr:=false;
       end;
    end;
end;


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


Procedure VGA_Font_delete(fnt:pointer);
var pf:PFontVGA;
begin
pf:=fnt;
Dispose(pf,Done);
end;


Procedure Register_VGA_Loader;
begin
RegisterFontEngine('VGA',
                   @Load_VGA_font,
                   @VGA_Font_PrepChar,
                   @VGA_Font_OutText,
                   @VGA_Font_setstyle,
                   @VGA_Font_GetInfo,
                   @VGA_Font_delete);

end;




begin
Register_VGA_Loader;
end.
