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

const
   MAX_VGA_CHARSET_HIGH = 32;
   ADRESAR_S_FONTY:string = '';


type

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


PZnak = ^TZnak;
TZnak = object
  relx:shortint;
  rely:shortint;
  sirka:word;
  vyska:word;
  shift:shortint;
  dp:longint;
  data:pointer;
  {------------------}
  Procedure Init;
  Procedure Komprimuj;
  {z nenormalniho (docasneho) znaku udela normalni komprimovany znak}
  Procedure Dekomprimuj(pridejbod,duplikovat:boolean);
  {dekomprimovany muze byt jen prechodne}
  Procedure Udelej_Proporcni;
  {vyrobi z neproporcniho DEKOMPRIMOVANEHO znaku proporcni}
  Procedure LoadCompressedData(zdroj:pointer;bajtu,isirka,ivyska:longint);
  Procedure Done;
end;


PZnaky256 = ^TZnaky256;
TZnaky256 = object
  first,last:word;
  vel:byte;       {velikost fontu dle vnitrniho udaje}
  so,su:shortint; {space over, space under}
  {add:shortint - pevna cast mezery mezi znaky}
  prop:boolean; {proporcionalni font?}

  znaky256:array[0..255] of TZnak;
  Constructor Init(velikost:word);
  Function PrepChar(znak:word):pointer; {da odkaz na PZnak prislusneho znaku}
  Procedure NastavVelikost(velikost:word);
  Destructor Done;virtual;
end;

Procedure ZnakBuf_Expand(a:byte;p:pointer);
Function NormalizujJmenoFontu(s:string):string;
Procedure Pridej_9_bit(tempvga:PVGAcharset; vgakonv:PZnaky256; vyska:byte);
Procedure Preved_Font_na_proporcni(prop_font:PZnaky256;p:Pznaky256;size:byte);





{----------------------------------------------------------------------------}
implementation
{----------------------------------------------------------------------------}

Procedure ZnakBuf_Expand(a:byte;p:pointer);
var b:byte;
    q:pbyte;
begin
q:=p;
for b:=7 downto 0 do
    begin
    if odd(a) then q[b]:=1 else q[b]:=0;
    a:=a shr 1;
    end;
end;


Function NormalizujJmenoFontu(s:string):string;
begin
if Pos('\',s)=0 then NormalizujJmenoFontu:=ADRESAR_S_FONTY+s
              else NormalizujJmenoFontu:=s;
end;


Procedure Pridej_9_bit(tempvga:PVGAcharset; vgakonv:PZnaky256; vyska:byte);
var a:byte;
    p:pchar;

begin
p:=pointer(tempvga);
for a:=0 to 255 do
    begin
    vgakonv^.znaky256[a].init;
    vgakonv^.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 9. bit - u znaku $C0 az $DF se do 9. bitu kopiruje 8.}
    {u ostatnich je prazdny }
       then vgakonv^.znaky256[a].Dekomprimuj(true,true)
       else vgakonv^.znaky256[a].Dekomprimuj(true,false);

    vgakonv^.znaky256[a].shift:=9;
    vgakonv^.znaky256[a].Komprimuj;
    inc(p,MAX_VGA_CHARSET_HIGH);
    end;
end;


Procedure Preved_Font_na_proporcni(prop_font:PZnaky256;p:Pznaky256;size:byte);
var a:byte;
    z,n:PZnak;
begin
prop_font^.prop:=true;  {oznacime, ze font je proporcionalni}
for a:=0 to 255 do
    begin
    z:=p^.PrepChar(a);
    n:=@prop_font^.znaky256[a];
    n^.Init;
    n^.LoadCompressedData(z^.data,z^.dp,z^.sirka,size);
    n^.Dekomprimuj(false,false);
    n^.Udelej_Proporcni;
    n^.Komprimuj;
    n^.shift:=n^.sirka+2; {vypada to lepe nez "n^.sirka+1"}
    end;
end;


Procedure TZnak.Init;
begin
data:=nil;
dp:=0;
relx:=0;
rely:=0;
shift:=0;
end;


Procedure TZnak.LoadCompressedData(zdroj:pointer;bajtu,isirka,ivyska:longint);
begin
dp:=bajtu;
sirka:=isirka;
vyska:=ivyska;
GetMem(data,dp);
Move(zdroj^,data^,dp);
end;


Procedure TZnak.Komprimuj;
{Zkomprimuje znak}
var a,b,c,d,odp:longint;
    p,g,pp:pbyte;
    j:byte;
begin
if data=nil then Exit;
b:=sirka*vyska;
odp:=b;
d:=b mod 8;
a:=b div 8;
if d=0 then
   c:=a else c:=a+1; {v kolika bajtech bude definice znaku}

GetMem(p,c);
pp:=p;
g:=data;
for b:=0 to a-1 do {projedu vsechny cele zaplnene bajty}
    begin
    j:=(g[0] and 1) shl 7 + (g[1] and 1) shl 6 + (g[2] and 1) shl 5 +
       (g[3] and 1) shl 4 + (g[4] and 1) shl 3 + (g[5] and 1) shl 2 +
       (g[6] and 1) shl 1 + (g[7] and 1);
    p[b]:=j;
    inc(g,8);
    end;
{a ted jeste co zbylo (jestli neco zbylo)}
if d<>0 then
   begin
   j:=0;
   for b:=1 to d do
       begin
       j:=j+((g^ and 1) shl (8-b));
       inc(g);
       end;
   p[a]:=j;
   end;
FreeMem(data,odp);
dp:=c;
data:=p;
end;


Procedure TZnak.Dekomprimuj(pridejbod,duplikovat:boolean);
{Dekomprese znaku}
{Pokud je "pridejbod9" true, tak kazdy znak rozsiri o jeden bod. Pouziti
 nejspise pri rozsirovani osmibitovych VGA znaku do devitibodove "hardwarove"
 reprezentace.
 Pokud je "duplikovat" true, tak do posledniho bodu zduplikuje predposledni
 bod. V opacnem pripade ponecha posledni bod prazdny}
var a,c:longint;
    p,q:pbyte;
    prac:array[0..4095] of byte;
    m:byte;

begin
if data=nil then Exit;
if pridejbod then inc(sirka);
c:=sirka*vyska;
p:=data;               {stary buffer}
q:=@prac;
{Komprimovana data expanduju pres mezibuffer. To je absolutne nutne a pokud se
 to neudela, tak to vede k velmi tezko odhalitelnym chybam. Pricinou je to,
 ze SIRKA*VYSKA < DP div 8  --> nasledkem je prepsani nekolika bajtu za
 bufferem, coz vede k divnym vecem}
for a:=0 to dp-1 do
    begin
    ZnakBuf_Expand(p[a],q);
    inc(q,7);
    if pridejbod then
       begin
       if duplikovat then m:=q^ else m:=0;
       inc(q);
       q^:=m;
       end;
    inc(q);
    end;

dp:=c;
FreeMem(data);         {smazu komprimovany blok}

GetMem(data,dp);       {a rovnou pripravim novy pro dekompimovana data}
Move(prac,data^,dp);   {a prekopiruju je z pracovniho bufferu}
end;


Procedure TZnak.Udelej_Proporcni;
{Pozor! Font vstupujici do teto procedury musi byt dekomprimovany.}
{Nikde to neni kontrolovano!}
var a,c,d,l,odp,osirka,vlevo,vpravo:longint;
    p,nove:pbyte;
    h,ch:^byte;
    bod:boolean;

begin
if data=nil then Exit;
vlevo:=0;
vpravo:=0;

p:=data;
odp:=dp;
osirka:=sirka;

{1.faze - budu zleva doprava hledat nejaky bod}
bod:=false;
for d:=0 to sirka-1 do
    begin
    h:=p;
    inc(h,d);
    for c:=1 to vyska do
        begin
        if h^<>0 then begin bod:=true;Break;end;
        inc(h,sirka);
        end;
    if bod then Break else inc(vlevo);
    end;

if bod=false then Exit; {nenasel jsem zadny bod, tudiz jde o prazdny znak}

{2.faze - mam najity nejlevejsi bod a ted budu hledat nepravejsi}
bod:=false;

for d:=0 to sirka-1 do
    begin
    h:=p;
    inc(h,sirka-1);
    dec(h,d);
    for c:=1 to vyska do
        begin
        if h^<>0 then begin bod:=true;Break;end;
        inc(h,sirka);
        end;
    if bod then Break else inc(vpravo);
    end;

{3. faze - znak vlevo orizneme o VLEVO a vpravo o VPRAVO}
dec(sirka,vpravo+vlevo);
if vpravo+vlevo<>0 then dec(shift,vpravo+vlevo-2);

dp:=vyska*sirka;
GetMem(nove,dp);
ch:=nove;

h:=p;
inc(h,vlevo);

for c:=0 to vyska-1 do
    begin
    move(h^,ch^,sirka);
    inc(h,osirka);
    inc(ch,sirka);
    end;

FreeMem(data);
data:=nove;
end;


Procedure TZnak.Done;
begin
if data<>nil then FreeMem(data);
data:=nil;
dp:=0;
end;


Constructor TZnaky256.Init(velikost:word);
var a:byte;
begin
first:=0;
last:=255;
for a:=0 to 255 do znaky256[a].init;
NastavVelikost(velikost);
end;


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


Function TZnaky256.PrepChar(znak:word):pointer;
begin
PrepChar:=@znaky256[znak];
end;


Destructor TZnaky256.Done;
var a:byte;
begin
for a:=0 to 255 do Znaky256[a].Done;
first:=0;
last:=0;
vel:=0;
so:=0;
su:=0;
end;


end.
