unit FnFont2;
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
(*                                                                         *)
(*  Jednotka pro vystup textu pro vystup textu pomoci graficke knihovny    *)
(*  VenomGFX                                                               *)
(*                                                                         *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)

{$INCLUDE defines.inc}

interface
uses Vaznik,Tedradky;
const
   FN_OK        =    0;
   FN_LOADERROR =    1;
   FN_PRAZDNY_ZASOBNIK = 4;



   FN_FONT_VGA16   = '__VGA16';    {proporcionalni VGA 8x16 font}
   FN_FONT_VGA16_U = '__VGA16_U';  {neproporcionalni VGA 6x16 font}

   FN_FONT_VGA14 = '__VGA14';    {proporcionalni VGA 8x14 font}
   FN_FONT_VGA8  = '__VGA8';     {proporcionalni VGA 8x8 font}

type
znakdef = packed record
  relx:shortint;
  rely:shortint;
  sirka:byte;
  vyska:byte;
  shift:shortint;
  dp:word;
  data:pointer;
end;

_pole_znaku = array[0..65535] of znakdef;
pole_znaku = ^_pole_znaku;


{Struktura FN obsahuje informace o fontu. Budto muzes nacitat fonty z D.mentova
 formaru FN, obraz znakove sady VGA nebo primo parave pouzivana znakova z
 generatoru VGA. Rovnez mohou byt nacitany Unicode fonty od Matheuse Viste.
 Pokud jsou je nacten 256 znakovy font (tzn. ne unicode), jsou v poli DATA
 bitmapy rozpakovane. Tedy jeden pixel = 1 bajt. Pokud je to unicode, jsou
 zapakovane: jeden pixel = 1 bit.}
PFont = ^TFont;
TFont = record
  rez:string[30];       {nazev souboru na disku}
  vnitrnijmeno:pchar;
  first,last:word;      { prvni definovany, posledni definovany }
  poc_znaku:word;       {pocet skutecne definovanych znaku. Ma vyznam pro unicode}
  so,su,add:shortint;{ space over, space under, pevna cast mezery mezi znaky }
  maxpred,maxza,maxpod,maxnad:shortint;
  unicode:boolean;
  komp:boolean;
  znak:pole_znaku;
end;



type
  Pfnslr = ^Tfnslr;
  Tfnslr = record
  font:PFont;
  id:string[30];
  end;

Procedure Init_FNSLR;
Procedure Znic_FNSLR;
Function Tagy_na_Vaznik(s:pchar;f:PFont):PItRadek;
Function NajdiKritickyObrazek(const s:string):longint;
Procedure NastavVystup(v:pointer);  {musi jit o ukazatel na VirtualWindow}
Procedure ZjistiVystup(var v:pointer);  {musi jit o ukazatel na VirtualWindow}
Function Nacti_FNSLR(s:string):PFont;
Function Najdi_ve_FNSLR(s:string):pfnslr;
Function FNSLR_dej_ID(f:PFont):string;
Procedure CiziFormat_Do_FN(s:string;var f:PFont);
Procedure CiziFormat_Do_FN(s:string;var f:PFont;povol_cizi:byte);
Procedure Nacti_FN(rez:string;var f:PFont);     { nahraje do pameti font (nejen .FN)}
Procedure Nacti_FN(rez:string;var f:PFont;povol_cizi:byte);
Procedure VGAfont_2_PFont(s:string;var f:PFont;prevod_na_9bit:boolean);
{Do formatu PFont prevede VGA font z pameti nebo ze souboru. Nebude Komprimovany}
Function ZkontrolujUnicodeFormat(s:string):boolean;

{---------------------Analog OuttextXY----------------------}
Function Print_Char(x,y:longint;znak:longint;f:PFont;barva:longint):byte;
Function Print_Char(x,y:longint;znak:longint;f:PFont;barva:longint;var w1,w2,w4:longint):byte;

{vytiskne jen jeden znak}
Procedure Print_It(x,y:longint;ss:pitradek);
Procedure Print_FN(x,y:longint;s:pchar);
Procedure Print_FN(x,y:longint;s:string);
Procedure Print_FN(x,y:longint;s:string;f:PFont);
Procedure Print_FN(x,y:longint;s:pchar;f:PFont);
Procedure Print_FNTag(x,y:longint;s:pchar;f:PFont);
Procedure Print_FNTag(x,y:longint;s:string;f:PFont);
{-----------------------------------------------------------}

Procedure FontAdr(s:string);
Function GetFontAdr:string;
function AktualniFont_FN:PFont;
function AktualniFont:string;
Procedure NastavAktualniFont(s:string);
Procedure NastavDeepSysFont(s:string);
function String2FN(s:string):PFont;
Function Je_Font_Unicode(s:string):boolean;
Procedure Znic_FN(var f:PFont);

Function Vyska_FN(f:PFont):longint;
Function Sirka_IT(s:pitradek):longint;
Function SirkaUseku_IT(s:PItRadek;poz,delka:longint):longint;
Function SirkaUseku_IT(s:pItradek;p:PUzel;poz,delka:longint):longint;
Function Sirka_FN(s:string;e:PFont):longint; { stejne jako "TextWidth" z unitu Graph }
Function Sirka_FN(s:pchar;e:PFont):longint;
Function Vyska_FN_aktual:byte;
Function Sirka_FN_na_Xpoz(p:pchar;font:PFont;x:longint):longint;
Function SirkaZnaku(e:PFont;znak:longint):longint;
Function SirkaBitmapyZnaku(e:PFont;znak:longint):longint;
Function VyskaBitmapyZnaku(e:PFont;znak:longint):longint;
Function SirkaEvDodatecneMezery(v:PItRadek):longint;
Function Nedef_bitmapa_znaku(f:pfont;znak:longint):boolean;
{Da sirku toho, co je pred kurzorem}
Procedure VyskaUsekuRadky_IT(s:PItRadek;pozice,delka:longint;var cv,hv,dv:longint);
Procedure VyskaRadky_IT(s:PItRadek;var cv,hv,dv:longint);
Procedure VyskaRadky(s:pchar;var cv,hv,dv:longint);
Procedure VyskaRadky(s:string;var cv,hv,dv:longint);
Function RychlaVyskaRadky(s:string):longint;
Function RychlaVyskaRadky_IT(s:PItRadek):longint;
Function RychlaVyskaSO(s:string):longint;
Function RychlaVyskaRadky(s:pchar):longint;
Function RychlaVyskaSO(s:pchar):longint;
Function Pozice_v_Retezci(x,xs,spx:longint;s:pchar;f:PFont):longint;
Function Pozice_v_Retezci_IT(x,xs,spx:longint;ss:PItRadek;mod_mysi:boolean):longint;
Function Zjisti_X(poz:longint;ss:PItRadek):longint;

Procedure Make_proporcional(e:PFont;var f:PFont);
Procedure KomprimujZnak(var z:znakdef);
Procedure KomprimujFont(f:PFont);
Procedure UlozUnicodeFont(f:PFont;s:string);
Procedure NactiUnicodeFont(s:string;var f:PFont);
Function OdstranTagy(s:ansistring):ansistring;

Function Jsou_def_znaky_FN(s:string;f:PFont):longint;
{Jsou-li definovavy vsechny znaky v retezci, vrati 0, jinak pozici prvniho
nenalezeneho znaku v retezci}
Function PocetTagu(s:ansistring):longint;
Function SmazMezery_v_tagach(t:ansistring):ansistring;

Function Dej_nty_tag(s:ansistring;n:longint):string;
Function Tag_to_FNatrb(s:string;var so,su:longint):pfnatrb;
Function NajdiTag(s:ansistring;tag:string;var separat:string):longint;

Procedure Charset_2_FN(s:string;var f:PFont); { Vytvori FN font z definice
                                             znakove sady na disku
                                             (255 znaku v rastru 8x16 = 4096b) }

Procedure Schovej_Atributy_PIt_do_bufferu(p:pointer);
Procedure Obnov_Atributy_PIt_z_bufferu(p:pointer);


Procedure UlozNaZasobnikFontu(s:string);
Procedure UlozNaZasobnikBarev(w:word);
Procedure UlozNaZasobnikPozadi(w:longint);
Function OdeberZeZasobnikuFontu:string;
Function OdeberZeZasobnikuBarev:word;
Function OdeberZeZasobnikuPozadi:longint;
Procedure ZalohujZasobnikFontu(p:pointer;var v:byte);
{P by mel byt odkaz na pzas_fnt}
Procedure ObnovZasobnikFontu(p:pointer;var v:byte);
{P by mel byt odkaz na pzas_fnt}
Procedure ZalohujZasobnikBarev(p:pointer;var v:byte);
{P by mel byt odkaz na pzas_bar}
Procedure ObnovZasobnikBarev(p:pointer;var v:byte);
{P by mel byt odkaz na pzas_bar}
Procedure ZalohujZasobnikPozadi(p:pointer;var v:byte);
{P by mel byt odkaz na pzas_poz}
Procedure ObnovZasobnikPozadi(p:pointer;var v:byte);
{P by mel byt odkaz na pzas_poz}
Procedure VycistiZasobnikFontu;
Procedure VycistiZasobnikBarev;
Procedure VycistiZasobnikPozadi;

const

      NORMAL     = 0;
      URCIPOLOHU = 1;
      URCIZNAK   = 2;


      FN_error:longint = FN_OK;
      FN_skut_znak:longint = 0;
      FN_pozadi:longint = -1;          {pruhlednost}

      FN_pozadi_oznaceni_zda:boolean = false; {pruhlednost}
      FN_pozadi_oznaceni_barva:longint = 658;
      FN_color:word = 65535;
      FN_color2:word = 65535;
      FN_COLOR_K0:word = 64000;
      FN_COLOR_K1:word = 144;
      FN_COLOR_K2:word = 61376;
      FN_podtrh:boolean = false;
      FN_inverze:boolean = false;
      FN_NEPREJIMEJ_PRVNI_ATRIBUT:boolean = false;
      FN_odlisovat_char_0:boolean = false; {pres char 0 proskrtne caru}
      FN_vyznacovat_konec_radky:boolean = false; {na koncichradek delat kolecka}
      FN_DEBUG:boolean = false;


      FN_PCX_adresar:string = '';
      FN_PCX:string = '';
      FN_VGA16:PFont = nil;
      FN_VGA16_u:PFont = nil;
      FN_VGA14:PFont = nil;
      FN_VGA8:PFont = nil;
      FN_KONVERTUJ_NA_PROPORCIONALNI:boolean = true;

      FN_poz_v_ret_delka_radky:longint=0;
      FN_z_linky:boolean = true;  {jestli se Y souradnice u Print_FN chape}
                                  {jako poloha linky, na ktere sedi pismena}
                                  {nebo jako vrsek radky}

      FN_vector_font_size:byte = 16; {pro pouziti s CHR fonty}


var FN_selector:PVaznik;
    FN_poloha:array[0..2] of record
         x,y:longint;
         b:byte;
         n:longint;
         end;

    ZpracujChybu:procedure;

implementation
uses VenomMng,VenomGFX,Lacrt,Go32,Dos,GRPfile,vnm_pcx,vnm_gif,vnm_png,vnm_jpg;
const
      MAXFONT = 35;
      MAX_ZASOBNIKU_BAREV = 8;
      MAX_ZASOBNIKU_FONTU = 8;
      MAX_ZASOBNIKU_POZADI = 8;

      fnmagic:pchar='ëmÕonç ';
      unimagic:pchar='öaö';
      ak_Y:longint = 0;
      FN_adresar:string = '';
      max_Y:longint = 479;
      vrchol_zf:byte = 0;
      vrchol_zb:byte = 0;
      vrchol_zp:byte = 0;

      FN_default:string[30] = '__vga16';   { proporcionalni VGA font }
      FN_syst_font:string[30] = '__vga16';
      Fn_default_fn:PFont = nil;

type
pcharset = ^charset;
charset = Array[0..255,1..16] of Byte;


pzas_fnt = ^zas_fnt;
zas_fnt = array[0..MAX_ZASOBNIKU_FONTU] of string[15];
{Nulty index neni soucasti zasobniku, ale nekdy se sem uklada FN_DEFAULT}
pzas_bar = ^zas_bar;
zas_bar = array[0..MAX_ZASOBNIKU_BAREV] of word;
pzas_poz = ^zas_poz;
zas_poz = array[0..MAX_ZASOBNIKU_POZADI] of longint;


     unifont_header = packed record
     magic:array[1..4] of char;
     first:longint;
     last:longint;
     nahore:word;
     dole:word;
     end;

var target:PVirtualwindow;
    vrchol_zzf:byte;

    zasobnik_fontu:zas_fnt;
    zasobnik_barev:zas_bar;
    zasobnik_pozadi:zas_poz;

    ozas_f:pzas_fnt;
    ozas_b:pzas_bar;
    ozas_p:pzas_poz;
    ozas_fv,ozas_bv,ozas_pv:byte;
    opodtrh:boolean;

(*
function MyVal (S: string): longint;
var Pom2 : Integer;
    pom1 : longint;
begin Val (S, Pom1, Pom2);MyVal := Pom1;
end;

function MyStr (Cislo: longint): string;
var Vysledek : string;
begin Str (Cislo, Vysledek);MyStr := Vysledek;
end;

function Mid (S: ansistring; 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 SkipAllSpaces (S: ansistring): ansistring;
var i, N: Byte;
  Pom : string;
begin
i := 1;N := Length (S);Pom := '';
for i := 1 to N do if not (S[i] in [' ',#0]) then Pom := Pom + S[i];
SkipAllSpaces := Pom;
end;

Function Convert_UP(s:string):string;
var a:byte;
begin
for a:=1 to Length(s) do s:=UpCase(s[a]);
Convert_UP:=s;
end;

Function StripExt(s:string):string;
var p:pathstr;
    n:namestr;
    e:extstr;
begin
Fsplit(s,p,n,e);
StripExt:=e;
end;

function pSearch (Text:pchar;const S:string;Poz:longint):longint;
{ Funkce hleda string S v textu Text od pozice Pos (vcetne)}
var i, N: longint;
    c:char;
    d:boolean;

begin {Search}
if poz<1 then poz:=1;
dec(poz,2);
N:=Length(S);       {delka hledaneho retezce}
repeat
d:=true;
for i:=1 to N do
   begin
   c:=text[poz+i];
   if c=#0 then
      begin
      pSearch:=0;
      Exit;
      end
      else if c<>s[i] then begin inc(poz);d:=false;Break;end;
   end;
if D then begin pSearch:=poz+2;Exit;end;
until false;
end;

Function Search(Text:string;const S:string;Poz:longint):longint;
begin text:=text+#0;Search:=pSearch(@text[1],s,poz);end;


Function PLength(p:pchar):longint;
var q:pchar;
    l:longint;
begin l:=0;q:=p;
while q^<>#0 do begin inc(q);inc(l);end;
PLength:=l;
end;

Function NaPstring(s:string):pointer;
var p:pointer;
    l:longint;
begin
l:=Length(s)+1;
GetMem(p,l);
Move(s,p^,l);
NaPstring:=p;
end;*)

Procedure NastavVystup(v:pointer); {V je ukazatel na VirtualWindow}
begin
target:=v;
end;

Procedure ZjistiVystup(var v:pointer); {V je ukazatel na VirtualWindow}
begin
v:=target;
end;

Function CompareHeader(p:pointer):boolean;
var a:byte;
    b:pchar;
begin
b:=p;
CompareHeader:=true;
for a:=0 to 6 do
  begin
  if b^<>fnmagic[a] then CompareHeader:=false;
  inc(b);
  end;
end;

Function HeapPChar(s:string):pchar;
var p:pchar;
    n:byte;
begin
n:=Length(s);
if n=0 then Exit(nil);
GetMem(p,n+1);
Move(s[1],p^,n);
p[n]:=#0;
HeapPChar:=p;
end;

Procedure Expand(a:byte;p:pointer);
var b:byte;
    q:^boolean;
begin
q:=p;
inc(q,7);
for b:=0 to 7 do
    begin
    q^:=odd(a);
    a:=a shr 1;
    dec(q);
    end;
end;

Procedure UlozNaZasobnikFontu(s:string);
var a:longint;
begin
if vrchol_zf<MAX_ZASOBNIKU_FONTU then
   begin
   inc(vrchol_zf);
   zasobnik_fontu[vrchol_zf]:=s;
   end
   else begin {na zasobniku uz neni misto?}
   for a:=1 to MAX_ZASOBNIKU_FONTU-1 do         {ted se zasobnik zachova}
       zasobnik_fontu[a]:=zasobnik_fontu[a+1];  {jako fronta :-)}
   zasobnik_fontu[MAX_ZASOBNIKU_FONTU]:=s;
   end;
end;

Procedure UlozNaZasobnikBarev(w:word);
var a:longint;
begin
if vrchol_zb<MAX_ZASOBNIKU_BAREV then
   begin
   inc(vrchol_zb);
   zasobnik_barev[vrchol_zb]:=w;
   end
   else begin {na zasobniku uz neni misto?}
   for a:=1 to MAX_ZASOBNIKU_BAREV-1 do         {ted se zasobnik zachova}
       zasobnik_barev[a]:=zasobnik_barev[a+1];  {jako fronta :-)}
   zasobnik_barev[MAX_ZASOBNIKU_BAREV]:=w;
   end;
end;

Procedure UlozNaZasobnikPozadi(w:longint);
var a:longint;
begin
if vrchol_zp<MAX_ZASOBNIKU_POZADI then
   begin
   inc(vrchol_zp);
   zasobnik_pozadi[vrchol_zp]:=w;
   end
   else begin {na zasobniku uz neni misto?}
   for a:=1 to MAX_ZASOBNIKU_POZADI-1 do         {ted se zasobnik zachova}
       zasobnik_pozadi[a]:=zasobnik_pozadi[a+1];  {jako fronta :-)}
   zasobnik_pozadi[MAX_ZASOBNIKU_POZADI]:=w;
   end;
end;


Function OdeberZeZasobnikuFontu:string;
begin
if vrchol_zf<=0 then
   begin
   fn_error:=FN_PRAZDNY_ZASOBNIK;
   OdeberZeZasobnikuFontu:='';
   end
   else begin
   fn_error:=FN_OK;
   OdeberZeZasobnikuFontu:=zasobnik_fontu[vrchol_zf];
   dec(vrchol_zf);
   end;
end;

Function OdeberZeZasobnikuBarev:word;
begin
if vrchol_zb<=0 then
   begin
   fn_error:=FN_PRAZDNY_ZASOBNIK;
   OdeberZeZasobnikuBarev:=0;
   end
   else begin
   fn_error:=FN_OK;
   OdeberZeZasobnikuBarev:=zasobnik_barev[vrchol_zb];
   dec(vrchol_zb);
   end;
end;

Function OdeberZeZasobnikuPozadi:longint;
begin
if vrchol_zp<=0 then
   begin
   fn_error:=FN_PRAZDNY_ZASOBNIK;
   OdeberZeZasobnikuPozadi:=0;
   end
   else begin
   fn_error:=FN_OK;
   OdeberZeZasobnikuPozadi:=zasobnik_pozadi[vrchol_zp];
   dec(vrchol_zp);
   end;
end;

Procedure ZalohujZasobnikFontu(p:pointer;var v:byte);
begin
pzas_fnt(p)^:=zasobnik_fontu;
v:=vrchol_zf;
pzas_fnt(p)^[0]:=fn_default;
end;

Procedure ObnovZasobnikFontu(p:pointer;var v:byte);
begin
zasobnik_fontu:=pzas_fnt(p)^;
vrchol_zf:=v;
fn_default:=pzas_fnt(p)^[0];
end;

Procedure ZalohujZasobnikBarev(p:pointer;var v:byte);
begin
pzas_bar(p)^:=zasobnik_barev;
v:=vrchol_zb;
pzas_bar(p)^[0]:=fn_color;
end;

Procedure ObnovZasobnikBarev(p:pointer;var v:byte);
begin
zasobnik_barev:=pzas_bar(p)^;
vrchol_zb:=v;
fn_color:=pzas_bar(p)^[0];
end;

Procedure ZalohujZasobnikPozadi(p:pointer;var v:byte);
begin
pzas_poz(p)^:=zasobnik_pozadi;
v:=vrchol_zp;
pzas_poz(p)^[0]:=fn_pozadi;
end;

Procedure ObnovZasobnikPozadi(p:pointer;var v:byte);
begin
zasobnik_pozadi:=pzas_poz(p)^;
vrchol_zp:=v;
fn_pozadi:=pzas_poz(p)^[0];
end;

Procedure VycistiZasobnikBarev;
begin vrchol_zb:=0;end;

Procedure VycistiZasobnikFontu;
begin vrchol_zf:=0;end;

Procedure VycistiZasobnikPozadi;
begin vrchol_zp:=0;end;


Procedure UlozZasobniky;
begin
ZalohujZasobnikFontu(ozas_f,ozas_fv);
ZalohujZasobnikBarev(ozas_b,ozas_bv);
ZalohujZasobnikPozadi(ozas_p,ozas_pv);
opodtrh:=FN_podtrh;
end;

Procedure ObnovZasobniky;
begin
ObnovZasobnikFontu(ozas_f,ozas_fv);
ObnovZasobnikBarev(ozas_b,ozas_bv);
ObnovZasobnikPozadi(ozas_p,ozas_pv);
FN_podtrh:=opodtrh;
end;


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


Procedure Nacti_FN(rez:string;var f:PFont;povol_cizi:byte);
{Povol_cizi: 0 = zadny cizi font
             1 = pouze cizi 256 znakove
             2 = jakekoliv, i unicode}
var  a,b,l,v,w,c:longint;
     mgl:byte;
     ss,norm:string;
     p:pchar;
     z2,z3,t:^byte;
     n,m,oo:word;
     z:pointer;
   grp:TgrpStream;

begin
FN_error:=FN_LOADERROR;
norm:=NormalizujJmenoSouboru(rez);
grp.Init(norm,grpOpenRead);
if grp.status<>grpOK then
   begin
   f:=nil;
   grp.Done;
   ZpracujChybu;
   Exit;
   end;

mgl:=7; {Length(fnmagic);}
l:=grp.GetSize-mgl;
grp.Read(ss,mgl);        {nactu magic - tzn. overim format}
if CompareByte(ss,fnmagic^,mgl)<>0 then
   begin
   grp.Done;
   if povol_cizi>0 then
      CiziFormat_Do_FN(rez,f,povol_cizi); {tak je to v nejakem jinem formatu}
   Exit;
   end;

GetMem(p,l);             {pripravim si pamet}
w:=grp.ReadStream(p^,l); {nahraju do ni zbytek souboru}
grp.Done;                {ted uz muzu soubor zavrit}
if w<>l then             {nahralo se min, nez by melo? Je to chyba}
   begin
   f:=nil;
   ZpracujChybu;
   Exit;
   end;

New(f);
f^.rez:=StripName(norm)+StripExt(norm);
a:=IndexByte(p^,l,0);
if a=0 then f^.vnitrnijmeno:=nil
   else begin
   GetMem(f^.vnitrnijmeno,a+1);
   Move(p^,f^.vnitrnijmeno^,a+1);    {predani vnitrniho nazvu fontu}
   end;

f^.maxpred     :=127;
f^.maxza       :=-127;
f^.maxnad      :=127;
f^.maxpod      :=-127;
f^.unicode     :=false;
f^.komp        :=true;
f^.first:=byte(p[a+1]);
f^.last:=byte(p[a+2]);
f^.poc_znaku:=f^.last-f^.first+1;
f^.so:=shortint(p[a+3]);
f^.su:=shortint(p[a+4]);
f^.add:=shortint(p[a+5]);
if p[a+6]<>#0 then     {tento bajt se nazyva Future, musi byt 0}
   begin
   FreeMem(p);
   Znic_FN(f);
   ZpracujChybu;
   Exit;
   end;

GetMem(f^.znak,256*sizeof(znakdef));
GetMem(z,2048);

for b:=0 to f^.first do f^.znak^[b].data:=nil;
for b:=f^.last to 255 do f^.znak^[b].data:=nil;


for b:=f^.first to f^.last do
   begin

   Fillchar(f^.znak^[b],Sizeof(znakdef),0);

   c:=(b-f^.first)*7+a+7;
   Move(p[c],f^.znak^[b],5);               {nahraje metriku znaku}
   v:=f^.znak^[b].sirka*f^.znak^[b].vyska; { pocet bodu, ze kterych znak je }
   if v>0 then
      begin
      GetMem(f^.znak^[b].data,v); { alokuje bitmapu }
      w:=longint(p[c+5])+longint(p[c+6])*256;
      n:=(f^.znak^[b].sirka+7) div 8;
      t:=f^.znak^[b].data;     { zapisovaci pointer nastavi na bitmapu }
      for oo:=0 to f^.znak^[b].vyska-1 do
         begin
         z2:=z;
         for m:=0 to n-1 do
            begin
            Expand(byte(p[w-mgl+oo*n+m]),z2);
            inc(z2,8);
            end;
         Move(z^,t^,f^.znak^[b].sirka);
         inc(t,f^.znak^[b].sirka);
         end;

      {znak jsme dekomprimovali, ale ted ho prekvapive budu znovu komprimovat}
      {predchozi komprese totiz pakovala jednotlive radky zvlast, kdezto ja
      zapakuju celou bitmapu vcelku}
      KomprimujZnak(f^.znak^[b]);
      end else f^.znak^[b].data:=nil; { if V>0 }

   { *************************************************************** }

   with f^.znak^[b] do
     begin
     if relX<f^.maxpred       then f^.maxpred :=relX;
     if relY<f^.maxnad        then f^.maxnad  :=relY;
     if relX+sirka-1>f^.maxza  then f^.maxza   :=relX+sirka-1;
     if relY+vyska-1>f^.maxpod then f^.maxpod  :=relY+vyska-1;
     end;
   end;
FreeMem(z,2048);
system.FreeMem(p,l);
FN_Error:=FN_OK;
end;


Procedure Nacti_FN(rez:string;var f:PFont);
begin
Nacti_FN(rez,f,2);
end;


Procedure KomprimujZnak(var z:znakdef);
var a,b,c,d:longint;
    p,g,pp:pbyte;
    j:byte;
begin
if z.data=nil then Exit;
b:=z.sirka*z.vyska;
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:=z.data;
for b:=0 to a-1 do {projedu vsechny cele zaplnene bajty}
    begin
    j:=g[0] shl 7 + g[1] shl 6 + g[2] shl 5 + g[3] shl 4 + g[4] shl 3 + g[5] shl 2 + g[6] shl 1 + g[7];
    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^ shl (8-b);
       inc(g);
       end;
   p[a]:=j;
   end;

FreeMem(z.data);
z.dp:=c;
z.data:=p;
end;

Procedure KomprimujFont(f:PFont);
var a:longint;
begin
if f^.komp=false then
   begin
   for a:=f^.first to f^.last do KomprimujZnak(f^.znak^[a]);
   f^.komp:=true;
   end;
end;


Procedure DekomprimujFont(f:PFont);
var a,b,c:longint;
    p,q:pbyte;
    prac:array[0..4095] of byte;
begin
if f^.komp=false then Exit;
f^.komp:=false;
for b:=f^.first to f^.last do
    if f^.znak^[b].data<>nil then
       begin
       c:=f^.znak^[b].sirka*f^.znak^[b].vyska;
       p:=f^.znak^[b].data;
       q:=@prac;
       for a:=0 to f^.znak^[b].dp-1 do
           begin
           Expand(p[a],q);
           inc(q,8);
           end;
       GetMem(f^.znak^[b].data,c);
       Move(prac,f^.znak^[b].data^,c);
       f^.znak^[b].dp:=c;
       FreeMem(p);
       end;
end;



Procedure Znic_FN(var f:PFont);
var a:longint;
begin
if f^.vnitrnijmeno<>nil then FreeMem(f^.vnitrnijmeno);
for a:=f^.first to f^.last do
   if f^.znak^[a].data<>nil then FreeMem(f^.znak^[a].data,f^.znak^[a].dp);
if f^.unicode=false then FreeMem(f^.znak,256*sizeof(znakdef))
                    else FreeMem(f^.znak,65536*sizeof(znakdef));
Dispose(f);
end;

function String2FN(s:string):PFont;
var v:pfont;
begin
v:=Nacti_FNSLR(s);
String2FN:=v;
end;


Function Je_Font_Unicode(s:string):boolean;
var f:pfont;
begin
f:=String2FN(s);
if f=nil then Je_Font_Unicode:=false
   else Je_Font_Unicode:=f^.unicode;
end;


Function AktualniFont:string;
begin
AktualniFont:=FN_default;
end;


Function AktualniFont_FN:PFont;
begin
AktualniFont_FN:=fn_default_fn;
end;


Procedure NastavAktualniFont(s:string);
var b:byte;
    f:PFont;
begin
f:=Nacti_FNSLR(s);
if f<>nil then
   begin
   FN_default:=s;
   FN_default_fn:=f;
   end;
end;


Procedure NastavDeepSysFont(s:string);
var f:PFont;
begin
f:=Nacti_FNSLR(s);
if f<>nil then FN_syst_font:=s;
end;


Function IzolujSlovo_z_Tagu(s:string;b:byte):string;
const oddelovace:set of char = [';','>',#13,#10];
var a,c,d:byte;
    t:string;
begin
a:=b;
c:=b;
d:=Length(s)+1;
while (a>0) and (not (s[a] in oddelovace)) do dec(a);
while (c<d) and (not (s[c] in oddelovace)) do inc(c);
t:=Copy(s,a+1,c-a-1);
IzolujSlovo_z_Tagu:=t;
end;

Function Vysekni_Tag(ss:pchar;l,ds:longint;var delka:longint):string;
var m:longint;
    t:string;
begin
if l>ds then
   begin delka:=0;Exit('');end;

if (ss[l-1]='>') then
   begin delka:=1;Exit('');end;

if (ss[l-1]<>'<') then
   begin delka:=0;Exit('');end;

if (l=ds) then   {potencialni bug. Kdyz je < poslednim znakem retezce}
   begin delka:=0;Exit('');end;

if (ss[l]='<') then begin
   delka:=1;Exit('');
   end;
m:=PSearch(ss,'>',l);
if m=0 then          { neuzavreny tag? }
   m:=PSearch_error; { v tom pripade by v teto promenne mel byt konec retezce}

delka:=m-l+1;
t[0]:=char(delka);
Move(ss[l-1],t[1],delka);   {Tag je vyseknuty do T}
dec(delka);
t:=Convert_Up(SkipAllSpaces(t));
Vysekni_Tag:=t;
end;

Procedure Vyska_ze_Selektoru(s:string;var cv,hv,dv:longint);
var c,p:longint;
    f:PFont;
begin
f:=Nacti_FNSLR(s);  { nacist do selectoru }
p:=Vyska_FN(f);     { pripadne prohozeni }
if p>cv then cv:=p;
p:=f^.so;
if p>hv then hv:=p;
p:=f^.su;
if p>dv then dv:=p;
end;

Procedure VyskaUsekuRadky_IT(s:PItRadek;pozice,delka:longint;var cv,hv,dv:longint);
var f:PFont;
    v:Pfnatrb;
    n:longint;
begin
if s^.aa=nil then
   begin
   hv:=fn_default_fn^.so;
   dv:=fn_default_fn^.su;
   cv:=hv+dv;
   Exit;
   end;
hv:=0;
dv:=0;
if delka=0 then delka:=1;   {ochrana pred prazdnymi retezci}
n:=pozice+delka-1;
s^.aa^.Reset;
while not s^.aa^.Konec do
   begin
   v:=s^.aa^.Nacti;
   f:=v^.font;
   if v^.pozice>n then Break;
   if v^.pozice<pozice then
      begin
      hv:=f^.so;
      dv:=f^.su;
      end
      else begin
      if f^.so>hv then hv:=f^.so;
      if f^.su>dv then dv:=f^.su;
      end;
   end;
cv:=hv+dv;
end;

Procedure VyskaRadky_IT(s:PItRadek;var cv,hv,dv:longint);
begin
VyskaUsekuRadky_IT(s,1,s^.up,cv,hv,dv);
end;

Procedure VyskaRadky(s:pchar;var cv,hv,dv:longint);
var i:longint;
    v:PItRadek;
begin
{UlozZasobniky;}
v:=Tagy_na_vaznik(s,nil);
{ObnovZasobniky;}
VyskaRadky_IT(v,cv,hv,dv);
Dispose(v,Done);
end;

Procedure VyskaRadky(s:string;var cv,hv,dv:longint);
begin
s:=s+#0;
VyskaRadky(@s[1],cv,hv,dv);
end;

Function RychlaVyskaRadky(s:pchar):longint;
var cv,hv,dv:longint;
begin
VyskaRadky(s,cv,hv,dv);
RychlavyskaRadky:=cv;
end;

Function RychlaVyskaRadky_IT(s:PItRadek):longint;
var cv,hv,dv:longint;
begin
{VyskaRadky_IT(s,cv,hv,dv);
RychlaVyskaRadky_IT:=cv;}
RychlaVyskaRadky_IT:=s^.so+s^.su;
end;

Function RychlaVyskaSO(s:pchar):longint;
var cv,hv,dv:longint;
begin
VyskaRadky(s,cv,hv,dv);
RychlavyskaSO:=hv;
end;

Function RychlaVyskaRadky(s:string):longint;
begin
s:=s+#0;
RychlaVyskaRadky:=RychlaVyskaRadky(@s[1]);
end;

Function RychlaVyskaSO(s:string):longint;
var p:pchar;
begin
s:=s+#0;
p:=@s[1];
RychlaVyskaSO:=RychlaVyskaSO(p);
end;

Procedure Zatemni_FN(x1,y1,x2,y2:longint);
begin
if FN_pozadi_oznaceni_zda=true
   then Bar(target^,x1,y1,x2,y2,FN_pozadi_oznaceni_barva) else

if FN_pozadi>-1
   then Bar(target^,x1,y1,x2,y2,FN_pozadi);
end;

Procedure Podtrhni_FN(x1,x2,y:longint);
begin
if FN_podtrh then LineHorz(target^,x1,x2,y,FN_color);
end;

Procedure Prechod_na_novy_font(s:string);
var v:pfnslr;
    f:PFont;
begin
UlozNaZasobnikFontu(fn_default);
f:=Nacti_FNSLR(s);
v:=Najdi_ve_FNSLR(s);
FN_default:=s;
FN_default_fn:=f;
end;

Procedure Prechod_na_stary_font;
var s:string;
    a:byte;
    v:pfnslr;
begin
s:=OdeberZeZasobnikuFontu;
if fn_error=FN_OK then FN_default:=s;
v:=Najdi_ve_FNSLR(fn_default);
FN_default_fn:=v^.font;
end;

Procedure Prechod_na_novou_barvu(s:string);
begin
UlozNaZasobnikBarev(FN_color);
if s='!' then FN_color:=FN_color2 else FN_color:=MyVal(s);
end;

Procedure Prechod_na_starou_barvu;
var w:word;
begin
w:=OdeberZeZasobnikuBarev;
if fn_error=FN_OK then FN_color:=w;
end;

Procedure Prechod_na_nove_pozadi(s:string);
begin
UlozNaZasobnikPozadi(FN_pozadi);
if s[1]='-' then FN_pozadi:=-1 else
   FN_pozadi:=MyVal(s);
end;

Procedure Prechod_na_stare_pozadi;
var l:longint;
begin
l:=OdeberZeZasobnikuPozadi;
if fn_error=FN_OK then FN_pozadi:=l;
end;

Procedure Zmen_Podtrzeni(s:string);
begin
if s[1]='+' then FN_podtrh:=true else
if s[1]='-' then FN_podtrh:=false;
end;



Procedure Skok_na_novou_pozici(t:string;var x,y:longint);
var a,b:byte;
    s:string;
    r:real;
begin
a:=Pos(',',t);
s:=Copy(t,1,a-1);
delete(t,1,a);
{v S mame X-souradnici, v T Y-souradnici}
b:=Pos('%',s);       {Jdeme resit Xovou souradnici}
if b=0 then x:=MyVal(s) else
   begin
   r:=MyVal(Copy(s,1,b-1))/100*target^.breite-1;
   if s[b+1]='+' then r:=r+MyVal(Copy(s,b+2,255)) else
   if s[b+1]='-' then r:=r-MyVal(Copy(s,b+2,255));
   x:=round(r);
   end;

b:=Pos('%',t);       {Jdeme resit Yovou souradnici}
if b=0 then y:=MyVal(t) else
   begin
   r:=MyVal(Copy(t,1,b-1))/100*target^.hoehe-1;
   if t[b+1]='+' then r:=r+MyVal(Copy(t,b+2,255)) else
   if t[b+1]='-' then r:=r-MyVal(Copy(t,b+2,255));
   y:=round(r);
   end;
end;



Function Nacti_Obrazek(var s:string;var yr:longint):boolean;
var a,b,xp,yp:longint;
    barpr:longint;
    prac,prac2:string;
    v:PVirtualWindow;

begin
s:=SkipAllSpaces(s);
delete(s,1,4);
barpr:=0;
a:=Pos('(',s);
b:=Pos(')',s);
if b>a then
   begin
   if s[a+1]='-' then barpr:=-1 else barpr:=MyVal(Copy(s,a+1,b-a));
   delete(s,a,b-a+1);
   end;

a:=Pos(':',s);       { budeme obrazek polohovat?}
if a=0 then {ne?}
   begin
   prac:=s;
   xp:=0;
   yp:=0;
   end else {jo?}
   begin
   prac:=Copy(s,1,a-1);
   delete(s,1,a);
   a:=Pos(',',s);
   if a=0 then
      begin
      xp:=MyVal(s);
      yp:=0;
      end
      else
      begin
      xp:=MyVal(Copy(s,1,a-1));
      yp:=MyVal(Copy(s,a+1,Length(s)));
      end;
   end;

New(v);

if prac[Length(prac)]='"' then delete(prac,Length(prac),1);
if prac[1]='"' then delete(prac,1,1);

prac2:=Convert_UP(StripExt(prac));
if prac2='.PCX' then a:=Load_PCX(FN_PCX_adresar+prac,v^) else
if prac2='.BMP' then a:=Load_BMP(FN_PCX_adresar+prac,v^) else
if prac2='.GIF' then a:=Load_GIF(FN_PCX_adresar+prac,v^) else
if prac2='.PNG' then a:=Load_PNG(FN_PCX_adresar+prac,v^) else
if prac2='.JPG' then a:=Load_JPG(FN_PCX_adresar+prac,v^);

if a=0 then
   begin
   s:='IMX='+MyStr(longint(v))+','+MyStr(xp)+'#'+MyStr(yp)+':'+MyStr(barpr);
   yr:=v^.hoehe;
   Nacti_Obrazek:=true;
   end
   else begin
   s:='';
   yr:=0;
   Nacti_Obrazek:=false;
   end;
end;


Function VytahniObrazek(const s:string;var a:longint;var v:PVirtualwindow;var xr,yr,xp,yp,clr:longint):boolean;
var b,c,d,e:longint;
begin
a:=Search(s,'IMX=',a);        {A je v nem obrazek?}
if a=0 then Exit(false);

b:=Search(s,',',a+4);          {V}
c:=Search(s,'#',b+1);         {XP}
d:=Search(s,':',c+1);         {YP}

e:=Search(s,';',a);
if e=0 then e:=Length(s)+1;   {CLR}

v:=pointer(MyVal(Mid(s,a+4,b-1)));   {V}
xp:=MyVal(Mid(s,b+1,c-1));           {XP}
yp:=MyVal(Mid(s,c+1,d-1));           {YP}
clr:=MyVal(Mid(s,d+1,e-1));          {CLR}

xr:=v^.breite;
yr:=v^.hoehe;

a:=e;
VytahniObrazek:=true;
end;



Procedure Zobraz_Obrazek(const s:string;x,y:longint);
var v:PVirtualwindow;
    a,b,c,xr,yr,xp,yp:longint;
    barpr:longint;

begin
a:=1;
VytahniObrazek(s,a,v,xr,yr,xp,yp,barpr);
if barpr>=0 then PutClippedHCSprite(target^,v^,x+xp,y+yp,barpr) else
                 PutClippedSprite(target^,v^,x+xp,y+yp);

end;

Procedure DesifrujVysku(s:string;var so,su:longint);
var i:byte;
begin
so:=-1;
su:=-1;
i:=Pos(',',s);
case i of
   0:so:=MyVal(s);
   1:su:=MyVal(Copy(s,2,255));
   else begin
   so:=MyVal(Copy(s,1,i-1));
   su:=MyVal(Copy(s,i+1,255));
   end;
end;
end;

Procedure Zpracuj_Tag1(t:string;var so,su:longint;var u:string);
{Vola se v pripravne fazi pri konverzi tagu na atributove uzly}
var v,w:string;
    delka2,yr:longint;
begin
u:='';
so:=-1;
su:=-1;
if t='' then Exit;                {prazdny tag?}
if t[Length(t)]<>'>' then Exit;   {neuzavreny tag?}
delete(t,1,1);
repeat
v:=IzolujSlovo_z_Tagu(t,1);
delka2:=Length(v)+1;
delete(t,1,delka2);

{ihned se zpracuji tagy urcujici atributy textu (barva, font, pozadi...)}
if Copy(v,1,5)='FONT=' then        { ZMENA FONTU }
   Prechod_na_novy_font(Copy(v,6,delka2))
   else

if Copy(v,1,2)='SF' then           { FONT PREDTIM }
   Prechod_na_stary_font
   else

if Copy(v,1,6)='BARVA=' then       { ZMENA BARVY }
   Prechod_na_novou_barvu(Copy(v,7,delka2))
   else

if Copy(v,1,7)='POZADI=' then      { ZMENA POZADI }
   Prechod_na_nove_pozadi(Copy(v,8,delka2))
   else

if Copy(v,1,7)='PODTRH=' then
   Zmen_Podtrzeni(Copy(v,8,delka2)) { PODTRZENI TEXTU }
   else

if Copy(v,1,2)='SP' then           { POZADI PREDTIM }
   Prechod_na_stare_pozadi
   else

if Copy(v,1,2)='SB' then           { BARVA PREDTIM }
   Prechod_na_starou_barvu
   else

if Copy(v,1,6)='VYSKA=' then
   DesifrujVysku(Copy(v,7,delka2),so,su)
   else

   begin
   {nasledujici tagy uz nemaji charakter atributu textu - jso to jednorazove}
   {elementy typu obrazek. Ty nebudou zpracovany hned, ale az primo behem psani}

   if Copy(v,1,4)='IMG=' then {Pokud jde o obrazek, tak se na to podivame}
      begin                   {pozorneji}
      Nacti_Obrazek(v,yr); {Zkusime ho nacist (pri tom se muze zmenit V)}
      if yr<>0 then        {Jestlize byl uspesne nacten tak}
         begin
         if u<>'' then u:=u+';';
         u:=u+v;                  {pripiseme upraveny tag do extratagu}
         end;
      end
      else begin
      if u<>'' then u:=u+';';
      u:=u+v;
      end;
   end;
until Length(t)<2;     { Mozna by stacilo "...=0" }
end;


Procedure Zpracuj_Tag2(t:string;var x,y:longint);
{Zpracovani extra tagu, nemajicich charakter atributu textu. Volano procedurou
 Print_IT}
var v:string;
    delka2:longint;
begin
repeat
v:=IzolujSlovo_z_Tagu(t,1);
delka2:=Length(v)+1;
delete(t,1,delka2);
if Copy(v,1,4)='IMX=' then         { ZOBRAZI OBRAZEK }
   Zobraz_Obrazek(v,x,y)
   else


if Copy(v,1,5)='SKOK=' then        { PRESUN GRAFICKEHO KURZORU}
   Skok_na_novou_pozici(Copy(v,6,delka2),x,y)
   else
   ;

until Length(t)<1;
end;





Function NajdiKritickyObrazek(const s:string):longint;
var v:PVirtualwindow;
    a,y,yy,xr,yr,xp,yp:longint;
    barpr:longint;
    n:boolean;

begin
a:=1;
y:=0;
repeat
n:=VytahniObrazek(s,a,v,xr,yr,xp,yp,barpr);
if N then
   begin
   yy:=yr+yp;
   if yy>y then y:=yy;
   end;
until not N;

NajdiKritickyObrazek:=y;
end;


Procedure Schovej_Atributy_PIt_do_bufferu(p:pointer);
var q:pchar;
begin
q:=p;
Longint2pointer(FN_color,@q[0]);
Longint2pointer(FN_pozadi,@q[4]);
Byte2pointer(byte(FN_podtrh),@q[8]);
Byte2pointer(byte(FN_pozadi_oznaceni_zda),@q[9]);
Byte2pointer(byte(FN_inverze),@q[10]);
Longint2pointer(longint(FN_default_fn),@q[11]);
Move(FN_default,q[15],Length(FN_default)+1);
end;


Procedure Obnov_Atributy_PIt_z_bufferu(p:pointer);
var q:pchar;
begin
q:=p;
FN_color:=Pointer2Longint(@q[0]);
FN_pozadi:=Pointer2Longint(@q[4]);
FN_podtrh:=boolean(Pointer2Byte(@q[8]));
FN_pozadi_oznaceni_zda:=boolean(Pointer2Byte(@q[9]));
FN_inverze:=boolean(Pointer2Byte(@q[10]));
FN_default_fn:=pointer(Pointer2Longint(@q[11]));
Move(q[15],FN_default[0],byte(q[15])+1);
end;


Procedure NastavAtributy(v:Pfnatrb;jen_extra:boolean;var x,y:longint;var ff_:PFont);
var s:string;
begin
if jen_extra=false then
   begin
   FN_color:=v^.barva;
   ff_:=v^.font;
   s:=FNSLR_dej_ID(ff_);
   if s<>'' then FN_default:=s;
   FN_pozadi:=v^.pozadi;
   FN_podtrh:=(v^.modifikace and 1)<>0;
   FN_pozadi_oznaceni_zda:=(v^.modifikace and 2)<>0;
   FN_inverze:=(v^.modifikace and 4)<>0;
   end;
if v^.extra<>nil then
   begin
   {if FN_DEBUG then writeln(v^.extra^);}
   Zpracuj_Tag2(v^.extra^,x,y);
   end;
end;

Function NeznamyZnak(f:PFont;x,y:longint):longint;
var dx,dy:longint;
begin
if (f=nil) then
   begin
   dx:=8;
   dy:=8;
   end
   else begin
   dx:=SirkaBitmapyZnaku(f,79);  {rozmery ramecku vezmeme podle znaku "O"}
   dy:=VyskaBitmapyZnaku(f,79);
   end;

LineClipped(target^,x,y,x+dx,y,36960);
LineClipped(target^,x,y+dy,x+dx,y+dy,36960);
LineClipped(target^,x,y,x,y+dy,36960);
LineClipped(target^,x+dx,y,x+dx,y+dy,36960);
NeznamyZnak:=7;
end;





Function Zvyrazni_char_0(f:PFont;x,y,posun:longint):longint;
var dx,dy:longint;
begin
if (f=nil) then
   begin
   dy:=8;
   end
   else begin
   dy:=VyskaBitmapyZnaku(f,0);  {zkusime podle znaku 0, pripadne jako fallback...}
   end;                         {...pouzije znak "O"}

dx:=posun div 2;
Circle(target^,x+dx-1,y+dy div 2,dx,36960);
Zvyrazni_char_0:=7;
end;


Function Tag_to_FNatrb(s:string;var so,su:longint):pfnatrb;
var f:pfnatrb;
    t:string;
begin
t:='';
if s<>'' then
   begin
   s:=Convert_up(s);
   Zpracuj_Tag1(s,so,su,t);
   end;
f:=New(Pfnatrb,Init);
f^.DefaultA;
if t<>'' then
   f^.extra:=NaPstring(t);
Tag_to_FNatrb:=f;
end;



Function Print_Char(x,y:longint;znak:longint;f:PFont;barva:longint;var w1,w2,w4:longint):byte;
{Dulezite - polohu Y chape jako linku, na ktere sedi pismena.}
var bb:^byte;
    mimo:byte;
    z,wx1,wy1,wx2,wy2:longint;
    sbitmapy,vbitmapy:longint;

begin

{Definujeme zastupny znak Z, ktery poresi pripady nedefinovanych znaku}
if f^.unicode=false
   then if znak>255 then z:=32 else z:=znak
   else begin      {t.j. unicode=true}
   if Nedef_bitmapa_znaku(f,znak) then z:=32 else z:=znak;
   if (z<32) and (FN_odlisovat_char_0=true) then z:=32;
      {unicode fonty by nemely obsahovat znaky pro kody pod 32}
   end;

if z=znak then bb:=f^.znak^[znak].data else bb:=nil;

{}w1:=f^.znak^[z{znak}].relX+x;         {kde zahajit kresleni bitmapy - X}
{}w2:=f^.znak^[z{znak}].relY+y;         {kde zahajit kresleni bitmapy - X}
{}w4:=SirkaZnaku(f,znak);      {o kolik po vykresleni znaku posuneme X}

sbitmapy:=SirkaBitmapyZnaku(f,znak);
vbitmapy:=VyskaBitmapyZnaku(f,znak);


wx1:=x;
wy1:=y-f^.so;
wx2:=w1+w4-1;
wy2:=y+f^.su-1;

Zatemni_FN(wx1,wy1,wx2,wy2+1);  {vyrid prosvecovani pozadi}
                                {(to +1 je tam proto, ze chceme prosvitit i}
                                { jeden scanradek pod textem)}
Podtrhni_FN(wx1,wx2,y+1);

mimo:=PutChar_FN(target^,bb,w1,w2,
                               sbitmapy,
                               vbitmapy,
                               f^.znak^[z].dp,
                               barva);
{PutChar_FN se vola i pro nedefinovane znaky, a to z duvodu clippingu.
 (neni potreba se bat, nesnazi se vykreslovat pixely z neex. bitmapy)}

if znak=0 then
   if FN_odlisovat_char_0=true then Zvyrazni_char_0(f,w1,w2,sbitmapy)
   else else {t.j. z<>0}
   begin
   if bb=nil
      then if (znak<>32) then NeznamyZnak(f,w1,w2);
      {mezera nekdy nema fontech prirazenou bitmapu
       (rozmery ale definovane jsou)}
   end;
if FN_inverze then Inversion(target^,wx1,wy1,wx2,wy2);
                   {Bar(target^,wx1,wy1,wx2,wy2,55);}


Print_Char:=mimo;
end;


Function Print_Char(x,y:longint;znak:longint;f:PFont;barva:longint):byte;
var w1,w2,w4:longint;
begin
Print_Char:=Print_Char(x,y,znak,f,barva,w1,w2,w4);
end;



Procedure Print_It(x,y:longint;ss:PItRadek);
Label Preskok;
var a,b,d,znak,mimo:longint;
    w1,w2,w3,w4,xr:longint;
    fnp,konec_psani:boolean;
    q:PUzel;
    vv:Pfnatrb;
    ap:byte;
    mm,jex:boolean;
    s:pchar;
    bb:^byte;
     f:PFont;
    _odz,_doz,_posunv,_posunm:longint;
    buffer_na_atributove_promenne:array[0..255] of byte;


begin
{DEBUG --- if ss^.delka>20 then bar(vga,0,560,799,599,0);}
s:=ss^.p;
if ss^.aa=nil then begin q:=nil;vv:=nil;f:=fn_default_fn;end
   else begin
   q:=ss^.aa^.first;
   vv:=q^.vazba;
   f:=vv^.font;       {zacneme psat s timto fontem}
   end;


mimo:=-1;             {to znamena, ze dosud nebylo nic vypsano}
xr:=x;                {v pripade CRLF musi vedet, kam se vratit}
a:=1;                 {na zacatek retezce}
konec_psani:=false;

{if fn_z_linky=false then inc(y,ss^.so);}
if fn_z_linky=false then inc(y,f^.so);

fnp:=false;
for b:=0 to 2 do
    if (FN_poloha[b].B=URCIZNAK) then
       begin
       if (FN_poloha[b].N=1) then
          begin
          FN_poloha[b].x:=x;
          FN_poloha[b].y:=y;
          FN_poloha[b].b:=NORMAL;
          end else fnp:=true;
       end;

Schovej_Atributy_PIt_do_bufferu(@buffer_na_atributove_promenne);
_odz:=0;_doz:=0;_posunv:=0;_posunm:=0;
{============================================================================}
repeat
if q<>nil then
   if a=vv^.pozice then  {meni se na teto pozici atribut textu?}
      begin
      if FN_DEBUG then
         begin
         if f^.unicode
            then LineVert(target^,x,y-15,y+10,64040)
            else LineVert(target^,x,y-15,y+10,64060);
         end;
      jex:=((a=1) and (FN_NEPREJIMEJ_PRVNI_ATRIBUT=true));
      NastavAtributy(vv,jex,x,y,f);  {tak ho tedy zmen}
      q:=q^.dalsi;         {a o ted se zajimej o pristi zmenu}
      if q<>nil then vv:=q^.vazba else vv:=nil;
      end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
if ss^.up=0 then Goto Preskok;

if (ss^.Znak(a)=13) and (a<ss^.up-1) and (ss^.Znak(a+1)=10) then
{----------------------------------------------------------------------------}
   begin        {CRLF?, prechod na dalsi radek?}
   x:=xr;y:=y+f^.so+f^.su;
   inc(a);
   end
{----------------------------------------------------------------------------}

   else begin
   znak:=ss^.Znak(a);
   mimo:=Print_Char(x,y,znak,f,FN_color,w1,w2,w4);

   case mimo of
      0:{kompletne vypsany znak}
        begin
        if _odz=0 then _odz:=a;           {prvni kompletne vypsany znak}
        _doz:=a;                          {posledni kompletne vypsany znak}
        end;

      1:{uplne moc vpravo}
        begin
        ss^.lch:=znak;
        _posunv:=w4;       {zapamatuj si sirku prvniho nevypsaneho,}
                           {at vime, o kolik potom}
                           {posunout poc. zobrazeni tak, aby se}
                           {tento znak kompletne vypsal}

        konec_psani:=true; {jsme na pravem okraji - nema smysl dale psat}
        end;

      3:{castecne moc vpravo}
        begin
        ss^.lch:=znak;
        _posunv:=w1+w4-target^.breite+1;
        konec_psani:=true; {jsme na pravem okraji - nema smysl dale psat}
        end;

      2:{uplne moc vlevo}
        begin
        _posunm:=w4;
        {DEBUG --- if ss^.delka>20 then outtext(vga,a*10,570,char(znak),64000);}
        end;

      4:{castecne moc vlevo}
        begin
        _posunm:=-w1;
        {DEBUG --- if ss^.delka>20 then outtext(vga,a*10,570,char(znak),65535);}
        end;

      end;


   if FNP=true then
      for b:=0 to 2 do
          if (FN_poloha[b].B=URCIZNAK) then {hlidej pozici kurzoru}
             if (a=FN_poloha[b].N) then
                begin
                FN_poloha[b].x:=w1;{+w4-f^.znak^[znak].relX;}
                {if FN_poloha[b].x>target^.breiteminus1 then
                   FN_poloha[b].x:=target^.breiteminus1;}
                FN_poloha[b].y:=w2;
                FN_poloha[b].B:=NORMAL;  {Nalezeno. Uz s tim nebudeme hybat!}
                end;
   x:=x+w4;
   end;

inc(a);
until (a>ss^.up) or (konec_psani=true);

if FNP=true then
   for b:=0 to 2 do
       if (FN_poloha[b].B=URCIZNAK) then {hlidej pozici kurzoru}
          if FN_poloha[b].N=a then
             begin
             FN_poloha[b].x:=x;
             FN_poloha[b].y:=w2;
             FN_poloha[b].B:=normal;
             end
             else
          if FN_poloha[b].N>a then
             begin
             FN_poloha[b].x:=x+w4;
             FN_poloha[b].y:=w2;
             FN_poloha[b].B:=normal;
             end;


{}Preskok:{}

ss^.odz:=_odz;
ss^.doz:=_doz;
ss^.posunv:=_posunv;
ss^.posunm:=_posunm;

while q<>nil do    {jeste zpracuju uzly lezici mimo zobrazovanou oblast}
   begin
   vv:=q^.vazba;
   NastavAtributy(vv,false,x,y,f);
   q:=q^.dalsi;
   end;

{if FN_DEBUG and FN_odlisovat_char_0 then}

if FN_vyznacovat_konec_radky then
   begin
   if ss^.crlf=0 then a:=FN_COLOR_K0 else
   if ss^.crlf=1 then a:=FN_COLOR_K1 else a:=FN_COLOR_K2;
   circle(target^,x,y,4,a);
   end;

Obnov_Atributy_PIt_z_bufferu(@buffer_na_atributove_promenne);
end;


Function Zjisti_X(poz:longint;ss:PItRadek):longint;
var a,xx:longint;
    q:PUzel;
    vv:PFNatrb;
    c:word;
    f:PFont;

begin
if poz<=1 then Exit(0);
if poz>ss^.up then Exit(ss^.gd+1);

if ss^.aa=nil then begin q:=nil;vv:=nil;f:=fn_default_fn;end
              else begin q:=ss^.aa^.first;vv:=q^.vazba;f:=vv^.font;end;

xx:=0;
for a:=1 to poz-1 do
   begin
   if q<>nil then
       if a=vv^.pozice then  {meni se na teto pozici atribut textu?}
          begin
          f:=vv^.font;
          q:=q^.dalsi;                 {a o ted se zajimej o pristi zmenu}
          if q<>nil then vv:=q^.vazba else vv:=nil;
          end;
   c:=ss^.Znak(a);
   inc(xx,SirkaZnaku(f,c));
   end;
Zjisti_X:=xx;
end;


Function Tagy_na_Vaznik(s:pchar;f:PFont):PItRadek;
var i,j,k,l,n,so,su:longint;
      {q:PVaznik;}
      ff:PFont;
      e:PItRadek;
      v,v2,vp:pfnatrb;
      p:PVaznik;
      t:string;
      buffer_na_atributove_promenne:array[0..255] of byte;

begin
{Procedura je slozitejsi, nez by clovek cekal, kvuli tomu, ze se snazi plnit
PItRadek po delsich usecich, a ne proste po pismenkach. Takhle je to mnohem
rychlejsi}

Schovej_Atributy_PIt_do_bufferu(@buffer_na_atributove_promenne);
{schovame aktualni nastaveni parametru fontu, barev, atd}

e:=Init_PItRadek;
i:=0;
k:=1;
l:=0;
n:=1;

if f<>nil then
   begin
   v2:=Tag_to_FNatrb('',so,su);
   ff:=fn_default_fn;
   fn_default_fn:=f;
   end;
e^.PrvniUzel;

while s[i]<>#0 do
   begin
   if (s[i]='<') and (s[i+1]<>'<') then
      begin
      {Zacina tu tag?}
      if l<>0 then e^.VlozKus(s,e^.up+1,n,l);
      l:=0;
      t:=Vysekni_Tag(s,i+1,maxlongint,j); {to maxlongint je trochu risk}
      if t[length(t)]<>'>' then Break;  {neuzavreny tag?}

      v:=Tag_to_FNatrb(t,so,su);
      v^.pozice:=k;
      e^.UmistiUzel(v,k);

      inc(i,j);
      n:=i+2;
      end
      else begin
      {Zde tag neni?}

      {ale co kdyz tu jsou zvlastnosti s vetsi-mensi?}
      if (s[i]='<') or (s[i]='>') then
         begin
         e^.VlozKus(s,e^.up+1,n,l+1);
         l:=0;
         if (s[i]='<') or (s[i+1]='>') then inc(i);
         n:=i+2;
         end
      else inc(l);
      inc(k);
      end;
   inc(i);
   end;
   if l<>0 then e^.VlozKus(s,e^.up+1,n,l);

if f<>nil then   {na pocatku jsme si vynutili jiny font nez aktualni?}
   begin         {v tom pripade se na konci retezce k aktualnimu explicitne vratime}
   e^.UmistiUzel(v2,e^.up+1);
   fn_default_fn:=ff;
   end;

Obnov_Atributy_PIt_z_bufferu(@buffer_na_atributove_promenne);
{obnovime parametry fontu, barev, atd (tak jak byly)}

Tagy_na_Vaznik:=e;
end;

Procedure Print_FN(x,y:longint;s:pchar;f:PFont);
{Velmi zjednodusena verze Print_IT. Nijak neresi tagy ani dalsi vymozenosti.
 Pro fonty v unicode ale ocekava kodovani UTF-8}
var i,mimo:longint;
    z,w1,w2,w4:longint;
    posun:byte;
begin
if s=nil then Exit;
i:=0;
if f^.unicode then
   begin
   while s[i]<>#0 do
      begin
      z:=byte(s[i]);
      z:=UTF82word(s,maxlongint,i,posun);
      mimo:=Print_Char(x,y,z,f,FN_color,w1,w2,w4);
      if mimo=1 then Break;
      inc(x,w4);
      inc(i,posun);
      end;
   end
   else begin
   while s[i]<>#0 do
      begin
      z:=byte(s[i]);
      mimo:=Print_Char(x,y,z,f,FN_color,w1,w2,w4);
      if mimo=1 then Break;
      inc(x,w4);
      inc(i);
      end;
   end;
end;

Procedure Print_FN(x,y:longint;s:string;f:PFont);
begin
s:=s+#0;
Print_FN(x,y,@s[1],f);
end;

Procedure Print_FN(x,y:longint;s:string);
begin
s:=s+#0;
Print_FN(x,y,@s[1],AktualniFont_FN);
end;

Procedure Print_FN(x,y:longint;s:pchar);
begin
Print_FN(x,y,s,AktualniFont_FN);
end;


Procedure Print_FNTag(x,y:longint;s:pchar;f:PFont);
var v:PItRadek;
begin
v:=Tagy_na_vaznik(s,f);
Print_It(x,y,v);
Kill_PitRadek(v);
end;


Procedure Print_FNTag(x,y:longint;s:string;f:PFont);
begin
s:=s+#0;
Print_FNTag(x,y,@s[1],f);
end;


Function Vyska_FN(f:PFont):longint;
begin
if f=nil
   then Vyska_FN:=0
   else Vyska_FN:=f^.so+f^.su;
end;

Function Vyska_FN_aktual:byte;
var f:PFont;
begin
f:=AktualniFont_FN;
Vyska_FN_aktual:=Vyska_FN(f);
end;


Function Nedef_bitmapa_znaku(f:pfont;znak:longint):boolean;
begin
if f=nil then Nedef_bitmapa_znaku:=true else
if znak<0 then Nedef_bitmapa_znaku:=true else
if (f^.unicode=false) and (znak>255) then Nedef_bitmapa_znaku:=true
   else Nedef_bitmapa_znaku:=f^.znak^[znak].data=nil;
end;


Function SirkaZnaku(e:PFont;znak:longint):longint;
begin
if e=nil
   then SirkaZnaku:=0
   else begin
   if Nedef_bitmapa_znaku(e,znak)       {je definovan poptavany znak?}
      then if Nedef_bitmapa_znaku(e,79) {je definovan alespon znak "O"?}
           then SirkaZnaku:=9
           else SirkaZnaku:=e^.znak^[79].shift+e^.add
   else SirkaZnaku:=e^.znak^[znak].shift+e^.add;
   end;
end;


Function SirkaBitmapyZnaku(e:PFont;znak:longint):longint;
{pokud neni definovan ZNAK, tak jako nahradu zkusi pouzit znak "O"}
begin
if Nedef_bitmapa_znaku(e,znak)          {je definovan poptavany znak?}
   then if Nedef_bitmapa_znaku(e,79)    {je definovan alespon znak "O"?}
           then SirkaBitmapyZnaku:=8
           else SirkaBitmapyZnaku:=e^.znak^[79].sirka
   else SirkaBitmapyZnaku:=e^.znak^[znak].sirka;
end;


Function VyskaBitmapyZnaku(e:PFont;znak:longint):longint;
{pokud neni definovan ZNAK, tak jako nahradu zkusi pouzit znak "O"}
begin
if Nedef_bitmapa_znaku(e,znak)
   then if Nedef_bitmapa_znaku(e,79)
           then VyskaBitmapyZnaku:=8
           else VyskaBitmapyZnaku:=e^.znak^[79].vyska
   else VyskaBitmapyZnaku:=e^.znak^[znak].vyska;
end;


Function SirkaEvDodatecneMezery(v:PItRadek):longint;
var f:Pfont;
    a:PfnAtrb;
begin
if v^.aa=nil then f:=FN_default_fn else
   begin
   a:=v^.aa^.last^.vazba;
   f:=a^.font;
   end;
SirkaEvDodatecneMezery:=SirkaZnaku(f,32);
end;


Function SirkaUseku_IT(s:pItradek;p:Puzel;poz,delka:longint):longint;
var f:PFont;
    a,b,c:longint;
    vv:pfnatrb;
begin
b:=0;
if p<>nil then
   begin
   vv:=p^.vazba;
   f:=vv^.font;
   end else f:=fn_default_fn;

for a:=poz to poz+delka-1 do
    begin
    if p<>nil then
       if a=vv^.pozice then    {meni se na teto pozici atribut textu?}
          begin
          f:=vv^.font;
          p:=p^.dalsi;         {a o ted se zajimej o pristi zmenu}
          if p<>nil then vv:=p^.vazba else vv:=nil;
          end;
    c:=s^.Znak(a);
    inc(b,SirkaZnaku(f,c));
    end;
SirkaUseku_IT:=b;
end;

Function SirkaUseku_IT(s:pItradek;poz,delka:longint):longint;
var p:PUzel;
begin
p:=s^.VratUkazatelNaUzel(poz);
SirkaUseku_IT:=SirkaUseku_IT(s,p,poz,delka);
end;

Function Sirka_IT(s:PItRadek):longint;
begin
Sirka_IT:=SirkaUseku_IT(s,1,s^.up);
end;

Function Sirka_FN(s:pchar;e:PFont):longint;
var v:PItRadek;
begin
{UlozZasobniky;}
v:=Tagy_na_vaznik(s,e);
{ObnovZasobniky;}
Sirka_FN:=v^.gd;
Dispose(v,Done);
end;

Function Sirka_FN(s:string;e:PFont):longint;
begin
s:=s+#0;
Sirka_FN:=Sirka_FN(@s[1],e);
end;

Function Sirka_FN_na_Xpoz(p:pchar;font:PFont;x:longint):longint;
{Da sirku toho, co je pred kurzorem}
var c:char;
    xx:longint;
begin
dec(x);
c:=p[x];
p[x]:=#0;
xx:=Sirka_FN(p,font);
p[x]:=c;
Sirka_FN_na_Xpoz:=xx;
end;

Function Pozice_v_Retezci_IT(x,xs,spx:longint;ss:PItRadek;mod_mysi:boolean):longint;
{X relativni souradnice mysi bez pricteni Poc_Zobr}
{XS ze zacatku byva Poc_ZobrX}
{SPX je odsazeni prvniho znaku v radce pokud neni odrolovano}
var obx,bx:longint;
    f:PFont;
    a,c:longint;
    vv:pfnatrb;
    q:PUzel;

begin
if ss^.aa=nil then begin q:=nil;vv:=nil;f:=fn_default_fn;end
              else begin q:=ss^.aa^.first;vv:=q^.vazba;f:=vv^.font;end;
FN_skut_znak:=0;
FN_poz_v_ret_delka_radky:=0;
if ss^.up=0 then Exit(1);    {nejsem si uplne jisty, ma-li tu byt 1 nebo 0}

if x=xs then Exit(1);

if x<xs-spx then Exit(0);
if x<=xs then Exit(1);

bx:=xs+spx;
for a:=1 to ss^.delka do
    begin
    if q<>nil then
       if a=vv^.pozice then  {meni se na teto pozici atribut textu?}
          begin
          f:=vv^.font;
          q:=q^.dalsi;                 {a o ted se zajimej o pristi zmenu}
          if q<>nil then vv:=q^.vazba else vv:=nil;
          end;
    c:=ss^.Znak(a);
    obx:=bx;
    inc(bx,SirkaZnaku(f,c));
    if (bx>x) then
       begin
       FN_poz_v_ret_delka_radky:=bx-xs+1;
       if mod_mysi
          then if bx-x>x-obx then Exit(a) else Exit(a+1)
          else Exit(a);
       end;
    end;
Pozice_v_Retezci_IT:=a+1;
FN_poz_v_ret_delka_radky:=bx-xs+1;
end;

Function Pozice_v_Retezci(x,xs,spx:longint;s:pchar;f:PFont):longint;
var v:PItRadek;
    i:longint;
begin
{UlozZasobniky;}
v:=Tagy_na_Vaznik(s,f);
{ObnovZasobniky;}
i:=Pozice_v_Retezci_IT(x,xs,spx,v,true);
Pozice_v_Retezci:=i;
end;

Procedure Init_FNSLR;
begin
FN_selector:=NovyVaznik;
end;

Procedure Kill_fnslr(var p:pointer);
begin
Dispose(PFNslr(p));
end;

Procedure Znic_FNSLR;
begin
Vaznik_Done_all(FN_selector,@Kill_fnslr);
end;

Function Najdi_ve_FNSLR(s:string):pfnslr;
var v:Pfnslr;
begin
s:=Convert_Up(s);
FN_selector^.Reset;
while not FN_selector^.Konec do
   begin
   v:=FN_selector^.Nacti;
   if s=v^.id then Exit(v);
   end;
Najdi_ve_FNSLR:=nil;
end;

Function Nacti_FNSLR(s:string):PFont;
var v:pfnslr;
    f:PFont;
    t:string;
begin
s:=Convert_up(s);
v:=Najdi_ve_FNSLR(s);
if v<>nil then Exit(v^.font);      {font uz nacteny je}

{font nacteny neni - nacteme ho tedy}
{napred osetrim specialni pripady, kdy nacitam VGA fonty}
if s=FN_FONT_VGA16 then
   begin
   f:=FN_VGA16;
   t:=FN_FONT_VGA16;
   end
   else
if s=FN_FONT_VGA16_U then
   begin
   f:=FN_VGA16_u;
   t:=FN_FONT_VGA16_U;
   end
   else
if s=FN_FONT_VGA14 then
   begin
   f:=FN_VGA14;
   t:=FN_FONT_VGA14;
   end
   else
if s=FN_FONT_VGA8 then
   begin
   f:=FN_VGA8;
   t:=FN_FONT_VGA8;
   end
   else
{anebo je to skutecne soubor na disku}
   begin
   Nacti_FN(s,f);
   if f<>nil then t:=s else Exit(AktualniFont_FN);
   end;

New(v);
v^.font:=f;
v^.id:=t;
FN_selector^.InitNext(v);
Nacti_FNSLR:=f;
end;

Function FNSLR_dej_ID(f:PFont):string;
var v:pfnslr;
begin
FN_selector^.Reset;
while not FN_selector^.Konec do
   begin
   v:=FN_selector^.Nacti;
   if v^.font=f then Exit(v^.ID);
   end;
FNSLR_dej_ID:='';
end;


Procedure LoadCharsetFromVGA(var c:charset;vyska:byte);
{Stahne jeden font z VGA do pameti.
 Pozn: VGA fonty jsou jiz stazene z hardwaroveho znakoveho generatoru
 jednotkou VenomGFX}

var b:Byte;
    p:^rawvgachar;
begin
if vyska=16 then p:=@rawvga16 else
if vyska=14 then p:=@rawvga14 else begin p:=@rawvga8;vyska:=8;end;

for b:=0 to 255 do
    Move(p^[b,1],c[b,1],vyska);

end;



Function LoadCharsetFromDisk(var c:charset;s:string):longint;
var grp:TGRPStream;
    l:longint;
    a:byte;
begin
grp.init(s,grpOpenRead);
l:=grp.GetSize div 256;
for a:=0 to 255 do grp.Read(c[a,1],l);

grp.Done;
LoadCharsetFromDisk:=l;
end;


Function AnalyzujVGAFont(ch:PCharset;l: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}
var a:longint;
begin
for a:=1 to L do
    if odd(ch^[byte('M'),a]) then Exit(false);
AnalyzujVGAFont:=true;
end;


Procedure VGAfont_2_PFont(s:string;var f:PFont;prevod_na_9bit:boolean);
var ch:charset;
    a,b,c:byte;
    lh,ld,l,LL:longint;
    p:pbyte;
    prac:array[0..4095] of byte;
    povol9_bit_copy:boolean;
    r:longint;

begin
New(f);
f^.rez:=s;
f^.vnitrnijmeno:=HeapPChar(s);
if s=FN_FONT_VGA8 then
   begin
   LoadCharsetFromVGA(ch,8);
   l:=8;
   lh:=8;
   ld:=0;
   end else
if s=FN_FONT_VGA14 then
   begin
   LoadCharsetFromVGA(ch,14);
   l:=14;
   lh:=13;
   ld:=1;
   end else
if s=FN_FONT_VGA16_U then
   begin
   LoadCharsetFromVGA(ch,16);
   l:=16;
   lh:=14;
   ld:=2;
   end else
   begin
   l:=LoadCharsetFromdisk(ch,NormalizujJmenoSouboru(s));
   end;
case l of
  0..9:lh:=8;
  10..15:lh:=13;
  16:lh:=13;
  else lh:=l-3;
end; {case}
ld:=l-lh;


if prevod_na_9bit then
   begin r:=9;povol9_bit_copy:=AnalyzujVGAFont(@ch,L);end
   else r:=8;

f^.first:=0;
f^.last:=255;
f^.poc_znaku:=256;
f^.so:=lh;
f^.su:=ld;
f^.add:=0;
f^.maxpred:=0;
f^.maxza:=r;
f^.maxnad:=-Lh;
f^.maxpod:=ld;
f^.unicode:=false;
f^.komp:=false;    {jeste nemame zkomprimovano}
{f^.jmeno je prirazene uz na zacatku procedury}
GetMem(f^.znak,256*sizeof(znakdef));

LL:=L*r;  {t.j. 8xL nebo (9xL}


for a:=0 to 255 do
    begin
    f^.znak^[a].relx:=0;
    f^.znak^[a].rely:=-Lh;
    f^.znak^[a].shift:=R;      {t.j. 8 nebo 9}
    f^.znak^[a].sirka:=R;      {t.j. 8 nebo 9}
    f^.znak^[a].vyska:=Lh+ld;
    f^.znak^[a].dp:=LL;
    p:=@prac;
    for b:=1 to L do
        begin
        Expand(ch[a,b],p);
        if Prevod_na_9bit then
           begin
           if (a>$b9) and (a<$e0) then { musime vyresit 9. bit znaku }
              begin                    { u znaku $C0 az $DF se do 9. bitu kopiruje 8. }
              inc(p,7);                { u ostatnich je prazdny }
              c:=p^;
              inc(p);
              p^:=c;
              end else
              begin
              inc(p,8);
              p^:=0;
              end;
           inc(p);
           end
           else begin
           inc(p,8);
           end;
        end;
    GetMem(f^.znak^[a].data,LL);
    Move(prac,f^.znak^[a].data^,LL);
    end;
KomprimujFont(f);
end;


Procedure StareNacitaniUnicode(s:string;var f:PFont);
{Pouzitelne pouze pro pripad prevodu suroveho unicode fontu}
var a,b,c:longint;
    grp:TgrpStream;
    p,prac:pbyte;
    e,ff:PFont;
begin
grp.Init(NormalizujJmenoSouboru(s),grpOpenRead);
a:=grp.GetSize;
GetMem(prac,a);
grp.Read(prac^,a);
New(f);
f^.rez:=s;
f^.first:=0;
f^.last:=65535;
f^.so:=32;
f^.su:=0;
f^.add:=0;
f^.maxpred:=0;
f^.maxza:=17;
f^.maxnad:=-32;
f^.maxpod:=0;
f^.unicode:=true;
f^.komp:=true;
GetMem(f^.znak,65536*sizeof(znakdef));
p:=prac;
{inc(p);}
for b:=0 to 65535 do
    begin
    f^.znak^[b].relx:=0;
    f^.znak^[b].rely:=-32;
    f^.znak^[b].shift:=17{9};
    f^.znak^[b].sirka:=16;
    f^.znak^[b].vyska:=32;
    f^.znak^[b].dp:=64;

    if (b<128) or (is_bitmap_empty(p^,64)=false) then
       begin
       GetMem(f^.znak^[b].data,64);
       Move(p^,f^.znak^[b].data^,64);
       end else f^.znak^[b].data:=nil;
    {spakovana varianta}
    inc(p,64);
    end;
FreeMem(prac,a);

grp.Done;
end;


Procedure CiziFormat_Do_FN(s:string;var f:PFont;povol_cizi:byte);
{Promenna povol_cizi:  0,1: zakaz unicode
                         2: povoleno unicode}
var a:longint;
    grp:TGrpStream;
    e:PFont;
begin
grp.Init(NormalizujJmenoSouboru(s),grpOpenRead);
a:=grp.GetSize;

grp.Done;
if (a=2048) or (a=4096) or (a=3584)then {jeste jedna moznost - neni to unicode font, ale}
   begin                 {obraz VGA fontu na disku}
   VGAfont_2_PFont(s,e,true);
   if FN_KONVERTUJ_NA_PROPORCIONALNI then
      begin
      Make_proporcional(e,f);
      Znic_FN(e);
      end else f:=e;
   FN_Error:=FN_OK;
   Exit;
   end;
if povol_cizi>1 then NactiUnicodeFont(s,f);
end;


Procedure CiziFormat_Do_FN(s:string;var f:PFont);
begin
CiziFormat_Do_FN(s,f,2);
end;

Procedure MyVGA_2_FN;
var f8,f14,f16:PFont;
begin
VGAfont_2_PFont(FN_FONT_VGA8,f8,true);       {8x8}
VGAfont_2_PFont(FN_FONT_VGA14,f14,true);     {8x14}
VGAfont_2_PFont(FN_FONT_VGA16_u,f16,true);   {8x16}

Make_proporcional(f8,FN_VGA8);
Make_proporcional(f14,FN_VGA14);
Make_proporcional(f16,FN_VGA16);

FN_VGA16_u:=f16;
{FN_VGA14_u:=f14;
FN_VGA8_u:=f8;}


Znic_fn(f8);
Znic_fn(f14);
{a f16 ponecham}
end;




Procedure Charset_2_FN(s:string;var f:PFont);
begin
VGAfont_2_PFont(s,f,true);
end;

Procedure Make_proporcional(e:PFont;var f:PFont);
var a,c,d,l,vlevo,vpravo:longint;
    p:pointer;
    _v,_s:longint;
    h,ch:^byte;
    bod:boolean;
begin
New(f);
DekomprimujFont(e);
f^:=e^;
if e^.vnitrnijmeno<>nil then
   begin
   a:=PLength(e^.vnitrnijmeno)+1;
   Getmem(f^.vnitrnijmeno,a);
   Move(e^.vnitrnijmeno^,f^.vnitrnijmeno^,a);
   end;
if e^.unicode then l:=65536 else l:=256;
GetMem(f^.znak,l*sizeof(znakdef));
for a:=f^.first to f^.last do
 if e^.znak^[a].data=nil then
    begin
    f^.znak^[a]:=e^.znak^[a];
    f^.znak^[a].data:=nil;
    end
    else begin
    f^.znak^[a]:=e^.znak^[a];
    vlevo:=0;
    vpravo:=0;
    p:=e^.znak^[a].data;
    bod:=false;
    for d:=0 to e^.znak^[a].sirka-1 do
        begin
        h:=p;
        inc(h,d);
        for c:=1 to e^.znak^[a].vyska do
            begin
            if h^<>0 then begin bod:=true;Break;end;
            inc(h,e^.znak^[a].sirka);
            end;
        if bod then Break else inc(vlevo);
        end;

    if bod=true then
       begin
       bod:=false;
       for d:=0 to e^.znak^[a].sirka-1 do
           begin
           h:=p;
           inc(h,e^.znak^[a].sirka-1);
           dec(h,d);
           for c:=1 to e^.znak^[a].vyska do
               begin
               if h^<>0 then begin bod:=true;Break;end;
               inc(h,e^.znak^[a].sirka);
               end;
           if bod then Break else inc(vpravo);
           end;
       {Znak vlevo orizneme o VLEVO a vpravo o VPRAVO}
       dec(f^.znak^[a].sirka,vpravo+vlevo);
       if vpravo+vlevo<>0 then dec(f^.znak^[a].shift,vpravo+vlevo-2);
       d:=f^.znak^[a].sirka;

       f^.znak^[a].dp:=f^.znak^[a].vyska*f^.znak^[a].sirka;
       GetMem(f^.znak^[a].data,f^.znak^[a].dp);
       ch:=f^.znak^[a].data;
       for c:=0 to e^.znak^[a].vyska-1 do
           begin
           h:=p;
           inc(h,c*e^.znak^[a].sirka+vlevo);
           move(h^,ch^,d);
           inc(ch,d);
           end;


       {if f^.unicode then f^.znak^[a].shift:=20;}

       end else
       begin
       l:=e^.znak^[a].vyska*e^.znak^[a].sirka;
       e^.znak^[a].dp:=l;
       GetMem(f^.znak^[a].data,l);
       move(p^,f^.znak^[a].data^,l);
       end;
    end;
KomprimujFont(e);
KomprimujFont(f);
end;


Procedure UlozUnicodeFont(f:PFont;s:string);
var t:file;
    u:unifont_header;
    a,b,k:longint;
    r:packed record b:byte;w:word;end;
    w:packed record dp:byte;sirka:byte;end;
begin
Assign(t,NormalizujJmenoSouboru(s));
Rewrite(t,1);
move(unimagic^,u.magic,4);
u.first:=f^.first;
u.last:=f^.last;
u.nahore:=f^.so;
u.dole:=f^.su;
BlockWrite(t,u,sizeof(unifont_header));
b:=0;
for a:=f^.first to f^.last do
    if f^.znak^[a].data=nil then inc(b)

       else begin
       if b<>0 then
          begin
          r.b:=0;  {tento znak je prazdny}
          r.w:=b;  {prazdnych znaku je tolik a tolik}
          BlockWrite(t,r,sizeof(r));
          b:=0;
          end;
       w.dp:=f^.znak^[a].dp;
       w.sirka:=f^.znak^[a].sirka;
       BlockWrite(t,w,sizeof(w));  {v kolika bajtech je znak ulozen}
       BlockWrite(t,f^.znak^[a].data^,w.dp);
       end;
if b<>0 then
   begin
   r.b:=0;  {tento znak je prazdny}
   if b=65536 then r.w:=0 else r.w:=b; {prazdnych znaku je tolik a tolik}
      {pokud neni definovany ani jeden znak, tak je zde nula}
   BlockWrite(t,r,sizeof(r));
   end;
Close(t);
end;

Function ZkontrolujUnicodeFormat(s:string):boolean;
var grp:TGrpStream;
    p:array[1..4] of byte;
    q:pchar;
begin
grp.Init(NormalizujJmenoSouboru(s),grpOpenRead);
if grp.GetSize<5 then
   begin
   grp.Done;
   Exit(false);
   end;
q:=@p;
grp.Read(p,4);
grp.Done;
ZkontrolujUnicodeFormat:=comparebyte(q^,unimagic^,4)=0;
end;

Procedure NactiUnicodeFont(s:string;var f:PFont);
var grp:TGrpStream;
    p:pointer;
    q:pbyte;
    a,l,b,c:longint;
    u:unifont_header;
    dp,sirka:byte;
    maxs:longint;
begin
grp.Init(NormalizujJmenoSouboru(s),grpOpenRead);
l:=grp.GetSize;
GetMem(p,l);
grp.Read(p^,l);
grp.Done;
q:=p;
New(f);
f^.rez:=s;
f^.vnitrnijmeno:=HeapPchar(s);
GetMem(f^.znak,65536*sizeof(znakdef));

Move(q^,u,sizeof(unifont_header));
inc(q,sizeof(unifont_header));
f^.first:=u.first;
f^.last:=u.last;
f^.so:=u.nahore;
f^.su:=u.dole;
f^.add:=0;
f^.poc_znaku:=0;
f^.maxpred:=0;
f^.maxza:=0;
f^.maxnad:=-u.nahore;
f^.maxpod:=u.dole;
f^.unicode:=true;
f^.komp:=true;
maxs:=0;
b:=0;         {je to tu nutne - b je 4bajty, ale nacitame do nej jen 2}
a:=u.first;
repeat
    dp:=q^;inc(q);
    if dp=0 then   {nulovy bajt - to znamena, ze bude nasledovat B nedefinovanych znaku}
       begin
       move(q^,b,2);inc(q,2);
       if b=0 then b:=65536;{pokud je zde nula, tak neni definovan ani 1 znak}
       for c:=a to a+b-1 do
           begin
           f^.znak^[c].data:=nil;
           f^.znak^[c].shift:=8;
           f^.znak^[c].dp:=0;
           f^.znak^[c].rely:=-u.nahore;
           end;
       inc(a,b);
       b:=0;
       end
       else begin
       sirka:=q^;inc(q);
       if sirka>maxs then maxs:=sirka;
       f^.znak^[a].dp:=dp;
       GetMem(f^.znak^[a].data,dp);
       Move(q^,f^.znak^[a].data^,dp);inc(q,dp);
       f^.znak^[a].relx:=0;
       f^.znak^[a].rely:=-u.nahore;
       f^.znak^[a].sirka:=sirka;
       f^.znak^[a].shift:=sirka+2;
       f^.znak^[a].vyska:=u.nahore+u.dole;
       inc(f^.poc_znaku);
       inc(a);
       end;
until a>u.last;
f^.maxza:=maxs;
FreeMem(p,l);
FN_Error:=FN_OK;
end;

Function OdstranTagy(s:ansistring):ansistring;
var i,j,k,l:longint;
    t:ansistring;
begin
i:=1;
t:='';
j:=Length(s);
repeat
if (s[i]='<') then
   if (s[i+1]='<') then begin inc(i);t:=t+'<<';end
     else begin
     {nasli jsme tag}
     k:=i;
     while s[i]<>'>' do inc(i);
        {if i<=j then inc(i) else begin dec(i);Break;end;}
     end
     else t:=t+s[i];
inc(i);
until i>j;
OdstranTagy:=t;
end;

Function SmazMezery_v_tagach(t:ansistring):ansistring;
var a,b,j:longint;
    v_tagu:boolean;
begin
a:=1;
j:=Length(t);
v_tagu:=false;
repeat
b:=1;
if t[a]='>' then v_tagu:=false else
if t[a]='<' then v_tagu:=not v_tagu else
   if v_tagu and (t[a]=' ') then
      begin delete(t,a,1);dec(j);b:=0;end;
inc(a,b);
until a>j;
SmazMezery_v_tagach:=t;
end;

Function PocetTagu(s:ansistring):longint;
var i,j,k,l:longint;
begin
i:=1;
l:=0;
j:=Length(s);
repeat
if (s[i]='<') then
   if (s[i+1]='<') then inc(i)
     else begin
     {nasli jsme tag}
     k:=i;
     while s[i]<>'>' do inc(i);
        {if i<=j then inc(i) else begin dec(i);Break;end;}
     inc(l);
     end;
inc(i);
until i>j;
PocetTagu:=l;
end;

Function Dej_nty_tag(s:ansistring;n:longint):string;
var i,j,k,o:longint;
    t:string;
begin
i:=1;
o:=0;
t:='';
j:=Length(s);
repeat
if (s[i]='<') then
   if (s[i+1]='<') then inc(i)
     else begin
     {nasli jsme tag}
     k:=i;
     inc(o);
     while s[i]<>'>' do inc(i);
        {if i<=j then inc(i) else begin dec(i);Break;end;}
     if o=n then
        begin
        t:=Copy(s,k,i-k+1);
        break;
        end;
     end;
inc(i);
until i>j;
Dej_nty_tag:=t;
end;

Function Jsou_def_znaky_FN(s:string;f:PFont):longint;
var i,j:longint;
    ap:byte;
    w:word;
begin
s:=OdstranTagy(s);
j:=Length(s);
i:=1;
if f^.unicode then
   repeat
   w:=UTF82word(@s[1],j,i,ap);
   if Nedef_bitmapa_znaku(f,w) then Exit(i);
   inc(i,ap);
   until i>j
   else
   for i:=1 to Length(s) do
       if f^.znak^[byte(s[i])].data=nil then Exit(i);
Jsou_def_znaky_FN:=0;
end;

Function NajdiTag(s:ansistring;tag:string;var separat:string):longint;
var a,b,c,d:longint;
    v_tagu:boolean;
    t:ansistring;
begin
b:=Length(s);
v_tagu:=false;
tag:=Convert_Up(tag);
c:=Length(tag);
t:=Convert_Up(s);
for a:=1 to b do
    begin
    if t[a]='>' then v_tagu:=false else
    if t[a]='<' then v_tagu:=not v_tagu else
    if v_tagu and (Copy(t,a,c)=tag) then
       begin
       d:=a;
       repeat inc(d);
       until (d>=b) or (t[d+1]=';') or (t[d+1]='>');
       separat:=Mid(s,a,d);
       Exit(a);
       end;
    end;
separat:='';
NajdiTag:=0;
end;


Procedure FontAdr(s:string);
begin
if (ExistDir(s)=false) and (s<>'') Then Exit;
fn_adresar:=s;
end;

Function GetFontAdr:string;
begin
GetFontAdr:=fn_adresar;
end;

Procedure DefaultniZpracovaniChyby;
begin
end;


Procedure Init_FNfont2;
var b:byte;
begin
MyVGA_2_FN;
Init_FNSLR;
Nacti_FNSLR(FN_FONT_VGA16);
Nacti_FNSLR(FN_FONT_VGA16_U);
Nacti_FNSLR(FN_FONT_VGA14);
Nacti_FNSLR(FN_FONT_VGA8);
UlozNaZasobnikFontu(FN_FONT_VGA16);

new(ozas_f);
new(ozas_b);
new(ozas_p);

NastavAktualniFont(FN_FONT_VGA16);
for b:=0 to 2 do FN_poloha[b].B:=NORMAL;
NastavVystup(@vga);
ZpracujChybu:=@DefaultniZpracovaniChyby;
end;

begin
{Init_FNfont2;}
Venom_mngr_Init_graph_list(@Init_FNfont2);
{Opozdena inicializace jednotky. Nebude se volat ted, ale az pri
 VenomGFX.Init_Graph}
end.
