uses Dos,objects,VenomGFX,FNfont2,wokna32,w32const,Nadwokna,Lacrt,vaznik,
     kasmarun,filelist,Tedradky,rezklav;
{$INCLUDE defines.inc}
const
      koZMENA_FONT_OBJ_PREFIX=60000;


      koHELP        = 1;
      koHELP_ABOUT  = 11;
      koHELP_BMP    = 12;

      koNOVY        = 2;
      koFILES       = 3;
      koFILES_LOAD  = 31;
      koFILES_SAVE  = 32;
      koFILES_IBMP  = 33;
      koFILES_IVGAD = 34;
      koFILES_IVGAF = 35;
      koFILES_EVGAF = 36;
      koKONEC       = 4;

      koOBNOV       = 9;
      koJISTYKONEC  = 44;


      NEDEFINOVANY=-1;
      COMP_DECOMP=1;
      DEFAULTNI_SIRKA_ZNAKU=8;
      DEFAULTNI_VYSKA_FONTU=16;

      POCET_SLOTU_NA_FONTY=4;

      ZLUTA=65504;
      FIALOVA=63519;

      {
      ZLUTA=63519;
      FIALOVA=0;
      }

      SIRKA_MAPY_ZNAKU = 600;
      VYSKA_MAPY_ZNAKU = 580;
      POLOHA_MAPY_ZNAKU_X = 0;
      POLOHA_MAPY_ZNAKU_Y = 22;

type
     PZnaktab = ^TZnaktab;
     TZnaktab = packed record
     znak:word;
     x1,y1,x2,y2:word;
     vbloku:boolean;
     end;


const
KRESLITKO_XBUNEK = 60;
KRESLITKO_YBUNEK = 60;
KRESLITKO_VYSKA = 288;

type
     Tkreslitko = object(TMrizka)
     {sirka_znaku:byte;}
     znak:longint;
     nulovac:PTlacitko;
     ax1,ay1,ax2,ay2:longint;
     oax,oay,oab:longint;
     Constructor Init(ix,iy,isirka,ivyska,ixbodu,iybodu,ivyznam:longint);
     Procedure ZobrazMe;virtual;
     Procedure NakresliBunku(x1,y1,x2,y2,ix,iy,n:longint);virtual;
     Procedure NapisCisloZnaku(i:longint);
     Procedure PosledniUpravyPlatna;virtual;
     Procedure NovyZnak;
     Procedure PriradZnak(i:longint);
     Procedure Ohraniceni;
     Procedure DejOhraniceni(var ix1,iy1,ix2,iy2:longint);
     Function Konverze_Importu_z_VW(w:word):longint;virtual;
     Procedure Kontrola;virtual;
     Procedure Akce_L(var b:boolean);virtual;
     Procedure Akce_P(var b:boolean);virtual;
     Destructor Done;virtual;
     end;


     T_TBL_Prevodnik = array[128..255] of word;
     {T_TBL_Prevodnik_zpet = array[0..65535] of word;}


     TOknoZakladniLinky = object(TOkno_s_tlacitky)
     nat,dot:PTlacitko2;
     linka:longint;
     basestr:string;
     Constructor Init(ix,iy:longint;s,t:string);
     Procedure Akce(var i:longint);virtual;
     Procedure UkazNastaveniLinky;
     Destructor Done;
     end;

     PFontObjekt = ^TFontObjekt;
     TFontObjekt = object
     vw:PVyrez;    {sem se vykresli mapa fontu. Podle potreby se bude prubezne
                    inicializovat a rusit}
     pro_vw:VirtualWindow;   {bitmapa pro platno vyrezu VW}
     fnf:pfont;          {data fontu v nativnim formatu}
     fnt:string;         {nazev souboru}
     svazak:PVaznik;     {vaznik zpracovanych fontovych dat (typ TZnakTab)}
                         {je to jedina struktura, ktera ukazuje, ktere znaky}
                         {jsou definovane a ktere ne}

     Constructor Init;
     Procedure NewFont;
     Procedure NactiFont(s:string);
     Procedure UlozFont;
     Procedure RozpakujZnak(w:word;var v:virtualwindow);
     Procedure SpakujZnak(v:virtualwindow;w:word;zcela_novy:boolean);
     Procedure Data_do_noveho_svazaku;
     Procedure Novy_Prazdny_Svazak;
     Procedure Prirad_do_svazaku_souradnice(i,j:longint;var a,b:longint);
     Function DefZnak(i:longint):boolean;
     Function Svazak_SmazZnak(i:longint):boolean;
     Function Svazak_SmazZnak(u:PUzel):boolean;
     Procedure Svazak_VlozZnak(i:longint);
     Function Svazak_je_znak(i:longint):boolean;
     Function VFH:byte; {vyska fontu v jednom cisle}
     Procedure ZmenaVyskyFontu(nvfh:byte);
     Procedure ZmenaVyskyZnaku(w:longint;nvfh:byte);
     Procedure SmazVse;
     Procedure SmazZnak(i:longint);
     Procedure SmazZnak(i:longint;u:PUzel);
     Procedure Smaz_Font_ale_ne_bitmapy(ne_svazak:boolean);
     Procedure Dealokuj_pamet_pro_znak(i:longint);
     Procedure PripravNedefinovanyZnak(w,sirka,vyska:longint);
     Procedure VytvorPrazdnyZnak(w:word;sirka:byte);
     Procedure TransferujZnak(kam:byte;i:longint;prepisovat:boolean);
     Procedure Zkopiruj_Rozmery_a_ukazatele(kam:byte;smer:byte);
     Function ZaradZnak(i:longint):longint;
     Procedure ObklopZnak(i:longint);
     Procedure NastavSirkuZnaku(i:longint;b:byte);

     {vykreslovaci funkce}
     Procedure NakresliBunku(n:PZnakTab;prosvicena:boolean;v:virtualwindow);
     Procedure VykresliBunky(v:virtualwindow);
     Function Urci_znak_v_tabulce(mx,my:longint):PZnakTab;
     Procedure Priprav_Na_Zobrazeni;
     Procedure Zlikviduj_bitmapu;
     {-------------------}
     {Import z BMP}
     Procedure Analyzuj_BMP_Bunku(var v:virtualwindow);
     Procedure Extrahuj_BMP_Bunky(var v2:virtualwindow;pf:longint);
     Procedure VyjmiZnak_BMP_FFFF(var v2:virtualwindow;pf:longint);
     Function Importuj_BMP(s:string):boolean;
     Procedure Importuj_z_BMP;
     {-------------------}
     {Import z VGA}
     Procedure NatahniGlobalniDataFontu(f:PFont);
     Procedure Import_z_256z_PFont(f:PFont);
     Procedure Importuj_z_VGAD;
     Procedure Importuj_z_VGAF;
     Procedure Proved_Export_do_VGAF(s:string);
     Procedure Exportuj_do_VGAF;
     Function ZKontroluj_8px_sirku:boolean;
     Procedure Prekoduj_z_ASCII_do_UNI(t:string;smer:byte;pr:boolean);
     {-------------------}
     Destructor Done;
     end;


var  FontObjekt:PFontObjekt;{hlavni struktura zpracovavajici operace s fontem}

     FontObjekty:array[1..POCET_SLOTU_NA_FONTY+2] of TFontObjekt;
     {Posledni FontObjekt bude skryty a nebude mit sve tlacitko}
     FontObjTla:array[1..POCET_SLOTU_NA_FONTY] of TTlacitko;

     TBL_Prevodnik:T_TBL_Prevodnik;  {globalni promenna pro TBL konverze}

     kreslitko:TKreslitko;  {mrizka pro editovani znaku}
     schovane_pozadi:virtualwindow;
        {sem se schova cast obrazovky prekryta mapu znaku}

     {-------------globalni ovladaci prvky---------------}
     menu:PVybernicek;
     global_font_settings:TTlacitko;
     emptychars,deletechar,transferchars:TTlacitko;
     TlacitkoEditedChar:TTlacitko;
     usechar,cleargrid,inverse_grid:TTlacitko;
     swaphorz,swapvert,RotLeft,RotRight:TTlacitko;
     Posun_H,Posun_L,Posun_D,Posun_P:TTlacitko;
     sirenka:TCiselnik;
     {---------------------------------------------------}
     cznaku,pocitadlo,poc2:longint;
     prazdna_bunka:virtualwindow;
     OldExitProc:pointer;
     ss:PStrom;
     mmm:pfont;
     prostor_pro_text_FFFFh_v_mmm_fontu:longint;
     defch:word;

     dbgg:longint;

     {}global_debug_array:array[0..20] of longint;
     {}global_debug_count:longint;


Procedure MyExitProc;
begin
if ErrorAddr<>nil then
   begin
   Kill_Mouse;
   Kill_Graph;
   ExitProc:=@OldExitProc;
   end else ExitProc:=OldExitProc;
end;


Constructor TKreslitko.Init(ix,iy,isirka,ivyska,ixbodu,iybodu,ivyznam:longint);
begin
inherited Init(ix,iy,isirka,ivyska,ixbodu,iybodu,9{velikost bunky},1{sirka mrizky},ivyznam);
BB_mri_cara:=56975;
Ohraniceni;
NovyZnak;
end;

Procedure TKreslitko.Ohraniceni;
var i,j:longint;
begin
ax1:=(xbodu-sirenka.vrathodnotu) div 2;
if ax1<0 then ax1:=0;  {podle me nemuze nastat}

ax2:=ax1+sirenka.vrathodnotu-1;
if ax2>xbodu-1 then ax2:=xbodu-1;

ay1:=(ybodu-FontObjekt^.vfh) div 2;
if ay1<0 then ay1:=0;

ay2:=ay1+FontObjekt^.vfh-1;
if ay2>ybodu-1 then ay2:=ybodu-1;
end;


Procedure TKreslitko.DejOhraniceni(var ix1,iy1,ix2,iy2:longint);
begin
Ohraniceni;
ix1:=ax1;
iy1:=ay1;
ix2:=ax2;
iy2:=ay2;
end;


Procedure TKreslitko.NovyZnak;
begin
znak:=NEDEFINOVANY;
Clr(0);
CentrujZobrazeni;
oax:=-1;
oay:=-1;
oab:=-1;
end;


Procedure TKreslitko.NakresliBunku(x1,y1,x2,y2,ix,iy,n:longint);
var i:longint;
    w:word;
begin
if (iy<ay1) or (iy>ay2) then i:=0 else
if (ix<ax1) or (ix>ax2) then i:=1 else i:=2;

if DejBod(ix,iy)=1 then
   begin
   case i of
   2:w:=65535;
   0:w:=63488;
   1:w:=21151;
   end;{case}
   end
   else begin
   case i of
   2:w:=0;
   0:w:=30720;
   1:w:=20;
   end;{case}
   end;

Bar(platno^,x1,y1,x2,y2,w);
end;


Procedure TKreslitko.NapisCisloZnaku(i:longint);
var vw:virtualwindow;
    s:string;
    xe:longint;

begin

xe:=TlacitkoEditedChar.sirka;

Init_vw(vw,780-602-xe+1,20,false);
venomgfx.clr(vw,11648);
NastavVystup(@vw);
if i=NEDEFINOVANY then s:='undef.' else s:=MyStr(i);
Print_FNTag(0,17,'<barva=51200;pozadi=1077>'+s+'<pozadi=-;sb>',fn_vga16);
NastavVystup(@vga);
PutClippedSprite(vga,vw,602+xe,y-21);
Kill_VW(vw);
end;


Procedure TKreslitko.PosledniUpravyPlatna;
var by:longint;
begin
if FontObjekt^.fnf<>nil then
   begin
   by:=vysbodu*(FontObjekt^.fnf^.so+ay1)-Poc_ZobrY;
   LineHorz(platno^,0,platno^.breite-1,by,60160);
   end;
end;


Procedure TKreslitko.ZobrazMe;
begin
Ohraniceni;
inherited ZobrazMe;
NapisCisloZnaku(znak);
end;


Function TKreslitko.Konverze_Importu_z_VW(w:word):longint;
begin
if w=0 then Konverze_Importu_z_VW:=0 else Konverze_Importu_z_VW:=1;
end;


Procedure TKreslitko.PriradZnak(i:longint);
var v:virtualwindow;
    n:longint;
begin
if i<0 then Exit;
Clr(0);
FontObjekt^.RozpakujZnak(i,v);  {V se inicializuje automaticky}

n:=FontObjekt^.fnf^.znak^[i].sirka;

ImportVirtualWindow(v,align_s,align_s);

Znak:=i;
Ohraniceni;
Zobraz;
Kill_VW(v);

sirenka.VlozHodnotu(n);
sirenka.Zobraz;
end;

Procedure TKreslitko.Kontrola;
var mx,my:longint;
    a,b,mb:byte;
begin
inherited Kontrola;
end;


Procedure TKreslitko.Akce_L(var b:boolean);
var ax,ay:longint;
begin
if Bod_v_pozici(mouse.x-x,mouse.y-y,ax,ay) then
   if (ay>=ay1) and (ay<=ay2) then
      if (ax<>oax) or (ay<>oay) or (oab<>1) then
         begin
         Bod(ax,ay,1);
         Zobraz;
         oax:=ax;
         oay:=ay;
         oab:=1;
         end;
end;


Procedure TKreslitko.Akce_P(var b:boolean);
var ax,ay:longint;
begin
if Bod_v_pozici(mouse.x-x,mouse.y-y,ax,ay) then
   if (ay>=ay1) and (ay<=ay2) then
      if (ax<>oax) or (ay<>oay) or (oab<>2) then
         begin
         Bod(ax,ay,0);
         Zobraz;
         oax:=ax;
         oay:=ay;
         oab:=2;
         end;
end;


Destructor Tkreslitko.Done;
begin
inherited Done;
end;


Function TBL_Zahlavi_do_PItradku(var cesta:string;p:pointer):PItRadek;
var t:text;
    v:Psoubor_szn;
    f,s,s1,s2,ci:string;
    i,j:PItRadek;
    a,b:longint;
begin
v:=p;
if v^.jmeno^<>'[nic]' then
   begin
   f:=v^.jmeno^+'.'+v^.koncovka^;
   Assign(t,cesta+f);
   Reset(t);
   readln(t,s);
   Close(t);


   s:=SkipBegSpaces(s);
   s1:=Convert_down(VratSlovo(s,1));

   ci:=mystr(izolujprvnicislo(v^.jmeno^));

   if s1='unicode' then
      begin
      delete(s,1,length(s1));
      s2:=SkipBegSpaces(SkipEndSpaces(s));
      if s2[length(s2)]=')' then delete(s2,length(s2),1);
      if s2[1]='(' then delete(s2,1,1);
      s2:=s2+XMezer(20-Length(s2))+'<FONT=cour14.fn>(';
      f:=s2+f+')<SF>';
      a:=Pos(ci,f);
      delete(f,a,Length(ci));
      Insert('<BARVA=5444>'+ci+'<SB>',f,a);
      end;
   end
   else f:='<barva=64000>         <<no conversion>><sb>';

f:=f+#0;
i:=Tagy_na_vaznik(@f[1],nil);

TBL_Zahlavi_do_PItradku:=i;
end;


Function Vyber_TBL_soubor_okno(var ctv:boolean):string;
var ok:TLB_IT_okno;
    p,q:PVaznik;
    v,e:Psoubor_szn;
    i:PItRadek;
    ct:PCtverecek;
    j:longint;
    z,x:string;
    u,u2:PUzel;
    f:PWoknaZaklad;
    ofn:longint;

begin
z:=exedir+'key_tbl\';
x:='[nic]';
ofn:=FN_color;
NactiSeznamSouboru(p,z+'c*uni.tbl');  {seznam}

New(e);
e^.jmeno:=NaPstring(x);
e^.koncovka:=NaPstring(x);
e^._internal_JmenoVelkymi:=nil;
e^.data:=nil;
p^.InitNext(e);
q:=New(PVaznik,Init);

p^.Reset;
while not p^.Konec do
   begin
   v:=p^.Nacti;
   i:=TBL_Zahlavi_do_PItradku(z,v);
   q^.InitNext(i);
   end;

ok.Init(NA_STRED,NA_STRED,400,400,'Which ASCII-Unicode filter to use?',
        w_ok+#9+w_cancel,q,false);

if ctv=true then
   begin
   f:=ok.Najdi_dle_vyznam_pwz(ww_ok);
   dec(f^.x,70);
   f:=ok.Najdi_dle_vyznam_pwz(ww_zrus);
   dec(f^.x,70);
   ct:=New(PCtverecek,Init(ok.x+ok.sirka div 2+30,ok.y+ok.vyska-20,10,0));
   ct^.hodnota:=true;
   ok.Pridej(ct);
   ok.NapisS(ok.x+ok.sirka div 2 + 44,ok.y+ok.vyska-22,
                                     '<FONT=cour14.fn>Overwrite exist. chars?<SF>');
   end;

ok.Zobraz;
ok.Run;

if ok.hodnota=ww_ok then
   begin
   u:=ok.lb^.VratHodnotu;
   j:=q^.kolikaty_ve_vazniku(u);
   u2:=p^.Uzel(j);
   e:=u2^.vazba;
   if e^.jmeno^=x then z:=x
                  else z:=e^.jmeno^+'.'+e^.koncovka^;
   if ctv=true then ctv:=ct^.hodnota;  {pozor, z CT^.akt lze cist, jen kdyz je inicializovany}
   end
   else begin z:='';ctv:=false;end;

ok.Done;

ZrusSeznamSouboru(p);
SmazVaznikPItRadku(q);
Vyber_TBL_soubor_okno:=z;
FN_color:=ofn;
end;


Procedure Nacti_TBL_Prevodnik(s:string);
var f:file;
    p:pointer;
    i,j,k,l:longint;
    q:pchar;

begin
for i:=128 to 255 do TBL_Prevodnik[i]:=i;

Assign(f,exedir+'key_tbl\'+s);
Reset(f,1);
i:=Filesize(f);
GetMem(p,i);
BlockRead(f,p^,i);
Close(f);

q:=p;
for j:=0 to i do
    if q[j]=char($0a) then
       begin
       k:=j+1;
       inc(k);  {Tady je nejaky vyhrazeny bajt - nevim, co znamena, preskocim ho}
       for l:=128 to 255 do
           begin
           if k<i-1 then TBL_Prevodnik[l]:=longint(q[k])+longint(q[k+1])*256
                    else Break;
           inc(k,2);
           end;
       Break;
       end;

FreeMem(p,i);
end;


Function FontObjekt_num:byte;
var a:byte;
begin
for a:=1 to POCET_SLOTU_NA_FONTY do
    if FontObjekt=@FontObjekty[a] then Exit(a);
FontObjekt_num:=0;  {nesmi nikdy nastat}
end;


Procedure Ukaz_Stav_Tlacitek_FontObj_tla;
var a,b:byte;
    d:longint;
begin
b:=FontObjekt_num;
for a:=1 to POCET_SLOTU_NA_FONTY do
    begin
    if a=b then FontObjTla[a].bb_tla_txt:=65535
           else FontObjTla[a].bb_tla_txt:=0;
    d:=FontObjekty[a].fnf^.poc_znaku;
    FontObjTla[a].ZmenNapis('<font=cour14.fn>Font '+mystr(a)+
                            ' (defined chars: '+mystr(d)+')<sf>');
    FontObjTla[a].Zobraz;
    end;
end;


Procedure PripravObjekty;
var a,b,ofn:longint;
begin
ss:=StromDef(
Vetev(VytvorPolozku('Help','',koHELP,TRUE),
   UzelS(VytvorPolozku('About program','',koHELP_ABOUT,TRUE),
   UzelS(VytvorPolozku('Instructions for BMP import','',koHELP_BMP,TRUE),nil)),
SvazejS(
UzelS(VytvorPolozku('New','',koNOVY,TRUE),
Vetev(VytvorPolozku('Files','',koFILES,TRUE),
   UzelS(VytvorPolozku('Load','',koFILES_LOAD,TRUE),
   UzelS(VytvorPolozku('Save','',koFILES_SAVE,TRUE),
   UzelS(VytvorPolozku('Import from BMP','',koFILES_IBMP,TRUE),
   UzelS(VytvorPolozku('Import VGA font from DOS','',koFILES_IVGAD,TRUE),
   UzelS(VytvorPolozku('Import VGA font from file','',koFILES_IVGAF,TRUE),
   UzelS(VytvorPolozku('Export to VGA file','',koFILES_EVGAF,TRUE),nil)))))),
SvazejS(
UzelS(VytvorPolozku('Quit','',koKONEC,TRUE),nil))
))))
);

b:=23;
for a:=1 to POCET_SLOTU_NA_FONTY do
   begin
   FontObjekty[a].Init;  {soucasne bude mozne mit nactenych vice fontu}
   FontObjTla[a].Init(600,b,'<font=cour14.fn>Font '+mystr(a)+
                            ' (defined chars: 65536)<sf>',0,1,0);
   FontObjTla[a].bb_tla_v:=500;
   FontObjTla[a].bb_tla_v_sti:=28690;
   inc(b,20);
   end;
FontObjekty[POCET_SLOTU_NA_FONTY+1].Init;
FontObjekty[POCET_SLOTU_NA_FONTY+2].Init;
{a nakonec jeste nadefinuju jeste dva dalsi objekty na font, ale tu budou
 skryty a jen pro vnitrni pouziti}

FontObjekt:=@FontObjekty[1];     {implicitne budeme pouzivat prvni font}
Ukaz_Stav_Tlacitek_FontObj_tla;


Roztec_horiz_pol_vybernicku:=35;
menu:=New(PVybernicek,Init(500,0,vbVEDLESEBE+vbROZTAHNI,ss));
menu^.Zobraz;

global_font_settings.Init(600,103,'<barva=51200>Global font settings<sb>',0,2,0);
global_font_settings.Zobraz;

emptychars.Init(600,143,'Create <KLAVESY=eE;barva=65535>e<sb>mpty chars',0,1,0);
emptychars.Zobraz;

deletechar.Init(600,163,'<KLAVESY=dD;barva=65535>D<sb>elete chars',0,1,0);
deletechar.Zobraz;

transferchars.Init(600,183,'<KLAVESY=tT;barva=65535>T<sb>ransfer chars',0,1,0);
transferchars.Zobraz;

usechar.Init(600,203,'<KLAVESY=uU;barva=65535>U<sb>pdate from grid',0,1,0);
usechar.Zobraz;


sirenka.Init(600,244,DEFAULTNI_SIRKA_ZNAKU,1,20,0{,'Char width'});
sirenka.Zobraz;


TlacitkoEditedChar.Init(600,vga.hoehe-KRESLITKO_VYSKA-20-1,
                        'Ed<KLAVESY=dD;barva=33808>i<sb>ted char',0,1,0);
TlacitkoEditedChar.bb_tla_v:=600;
TlacitkoEditedChar.bb_tla_v_sti:=650;
TlacitkoEditedChar.Zobraz;


Kreslitko.Init(600,vga.hoehe-KRESLITKO_VYSKA-1,
               199,KRESLITKO_VYSKA,KRESLITKO_XBUNEK,KRESLITKO_YBUNEK,10{vyznam});
Kreslitko.Zobraz;

swaphorz.init(690,268,#27#26,0,1,0);
swaphorz.Zobraz;

swapvert.init(690+28,268,#24#25,0,1,0);
swapvert.Zobraz;

RotLeft.init(690+54,268,'L',0,1,0);
RotLeft.Zobraz;

RotRight.init(690+73,268,'R',0,1,0);
RotRight.Zobraz;

ClearGrid.Init(690+92,268,'C',0,1,0);
ClearGrid.Zobraz;

Inverse_Grid.Init(690+92,288,'I',0,1,0);
Inverse_Grid.Zobraz;

Posun_H.init(600,268,#24,15,1,0);
Posun_H.Zobraz;

Posun_D.init(620,268,#25,15,1,0);
Posun_D.Zobraz;

Posun_L.init(640,268,#27,15,1,0);
Posun_L.Zobraz;

Posun_P.init(660,268,#26,15,1,0);
Posun_P.Zobraz;
end;


Procedure Prenes_SO_na_znaky(var p:pointer);
var v:PZnakTab;
begin
v:=p;
FontObjekt^.fnf^.znak^[v^.znak].rely:=-FontObjekt^.fnf^.so;
end;


Procedure ZnicZnakTab(var p:pointer);
var v:PZnakTab;
begin
v:=p;
Dispose(v);
p:=nil;
end;


Procedure UkazAbout;
const p:pchar='<barva=51200>Kaçm r v2.0b<sb>'+#13#10+
   'This editor allows you to create or modify'+#13#10+
   'unicode fonts in UFN format'+#13#10+
   'used in Laaca''s Wokna32 system.'+#13#10+
   'Also you can use this program for conversion between'+#13#10+
   'unicode fonts and VGA font images used by many legacy utilities.'+#13#10+
   ' '+#13#10+
   '<barva=65535>Created by Laaca'+#13#10+
   'laaca@seznam.cz<sb>'+#13#10+
   'http://laaca.sweb.cz (english)'+#13#10+
   'http://laaca.borec.cz (czech)'+#13#10+
   ' '+#13#10+
   '<font=cour14.fn>This program can be spread under conditions'+#13#10+
   'of GNU GPL licence<sf>';

begin
OKokno('About',p);
end;

Procedure NapovedaKimportu;
const p:pchar='Font files in <barva=65535>TTF<sb> format can''t be imported directly.'+#13#10+
   'You have to use a external conversion tool <barva=51200>TTF2PCX<sb>'+#13#10+
   'This tool you can find in <barva=65535>.\TTF2PCX<sb> subdirectory.'+#13#10+
   'It is a windows application which converts TTF font into PCX image.'+#13#10+
   'Usage:'+#13#10+
   'In dialog windows select font, variant and size'+#13#10+
   'Ensure that options are set in this way: (it is important)'+#13#10+
   '<barva=65535>min. char:<sb> 0x20'+#13#10+
   '<barva=65535>max. char:<sb> 0xFFFF'+#13#10+
   '<barva=65535>output: <sb>monochrome'+#13#10+
   'After this step you have to convert the created PCX'+#13#10+
   'file into <barva=65535>BMP<sb> file (with any image converter)'+#13#10+
   'Such BMP copy into same directory where <barva=51200>Kaçm r<sb> resides'+#13#10+
   '<font=cour14.fn>Unfortunately TTF2PCX has a bug. It claims it can convert<sb>'+#13#10+
   'chars up to 65535, but in the fact handles chars only up to 32767<sf>';

begin
OKokno('Info about BMP import',p);
end;


Function AktivaceMenu(i:longint):longint;
var p:PStrom;
    j:longint;
    v:PPolozka;
begin
MouseRel;
p:=menu^.AktivujMenu(i);
if p<>nil then
   begin
   v:=p^.vazba;
   j:=v^.id;
   end else j:=0;
if j=koHELP_ABOUT then
   begin j:=0;UkazAbout;end else
if j=koHELP_BMP then begin j:=0;NapovedaKimportu;end;
AktivaceMenu:=j;
end;




Function BudemeMenitVyskuFontu:longint;
var d:TOkno_s_tlacitky;
    c:PCiselnik;
    s:string;
    ovfh,nvfh:byte;

begin
BudemeMenitVyskuFontu:=0;
ovfh:=FontObjekt^.vfh;

begin
d.init(NA_STRED,NA_STRED,250,170,'Changing font height',w_OK);
d.NapisS(d.x+5,d.y+25,'Changing font height affect'#13#10+
        'all chars because all chars'#13#10+
        'have the same height!'#13#10+
        #13#10+
        'allowed range: <barva=54112>1-32<sb>');
c:=New(PCiselnik,Init(d.x+40,d.y+120,ovfh,1,32,100));
d.Pridej(c);
d.NapisS(c^.x+65,c^.y,'<pozadi=1077>Font height<pozadi=->');

d.Zobraz;
d.Run;
nvfh:=c^.VratHodnotu;
d.Done;
end;
if ovfh<>nvfh then
   begin
   FontObjekt^.ZmenaVyskyFontu(nvfh);
   Kreslitko.Ohraniceni;
   Kreslitko.Zobraz;
   BudemeMenitVyskuFontu:=koOBNOV;
   end;
end;


Procedure UkazDistanci(x,y:longint;ds:longint;s:string);
var v:virtualwindow;
    i:longint;
    fo:word;
    myfnf:pfont;

begin
myfnf:=FontObjekt^.fnf;
if Jsou_def_znaky_FN(s,myfnf)=0 then
   begin
   Init_VW(v,305,Vyska_FN(myfnf)+10,false);

   clr(v,BA_TLA_v);
   NastavVystup(@v);

   i:=myfnf^.add;
   myfnf^.add:=ds;
   fo:=FN_color;
   FN_color:=51200;
   Print_FNTag(0,myfnf^.so,s,myfnf);
   FN_color:=fo;
   myfnf^.add:=i;

   NastavVystup(@vga);
   PutClippedSprite(vga,v,x,y+23);
   kill_VW(v);
   end
   else begin
   MouseHide;
   Print_FNTag(x,y+30,'There aren''t defined chars',fn_vga16);
   Print_FNTag(x,y+46,'for testing string:',fn_vga16);
   Print_FNTag(x,y+62,'<barva=51200>'+s+'<sb>',fn_vga16);
   MouseShow;
   end;
end;


Function DistanceMeziZnaky:longint;
var d:TCiselny_Dialog;
    e:PProstyText;
    n:PCiselnik;
    ok,zr:PTlacitko;
    q:pointer;
    u:PUzel;
    last_n:longint;
    distchr:string;
    myfnf:pfont;

begin
myfnf:=FontObjekt^.fnf;
DistanceMeziZnaky:=0;
distchr:='Million dollars';

   d.init(NA_STRED,NA_STRED,'Char distance',-10,20,myfnf^.add);
   {Ted provedu zmenu objektu TCiselnik uvnitr okna na TCiselnik_pro_distanci}
   ok:=d.Retez^.Uzel(1);
   zr:=d.Retez^.Uzel(2);
   n:=d.Retez^.Uzel(3);
   n^.ZmenPozici(n^.x,n^.y+2);
   last_n:=myfnf^.add;

   if Jsou_def_znaky_FN(distchr,myfnf)=0
      then d.Roztahni(d.sirka+200,Vyska_FN(myfnf)+70)
      else d.Roztahni(d.sirka+200,110);

   e:=New(PProstyText,Init(0,0,'Distance between chars',0));
   d.VlozNahoru(e);
   inc(e^.x,80);
   d.Zobraz;
   UkazDistanci(d.x+10,d.y+30,last_n,distchr);

   repeat
   HlidejKlavesy;
   d.PrvniZpracovaniKlaves;
   ok^.kontrola;
   zr^.kontrola;
   n^.kontrola;
   if n^.VratHodnotu<>last_n then
      begin
      last_n:=n^.VratHodnotu;
      UkazDistanci(d.x+10,d.y+30,last_n,distchr);
      end;
   until (ok^.stav=_aktivni) or (zr^.stav=_aktivni);
   if ok^.stav=_aktivni then myfnf^.add:=d.tc^.VratHodnotu;
   d.Done;
end;


Procedure Interval_Svazaku_do_uzlu(n1,n2:integer;var s1,s2:PUzel);
begin
s1:=FontObjekt^.svazak^.Uzel(n1);
s2:=FontObjekt^.svazak^.Uzel(n2);
end;


Function ZpracujRozsah(n1,n2:longint;var sva_p1,sva_p2:longint):boolean;
var p,p1,p2:PUzel;
    v:PZnakTab;
begin
p1:=nil;
p2:=nil;
sva_p1:=-1;
sva_p2:=-1;
p:=FontObjekt^.Svazak^.first;
while p<>nil do
   begin
   v:=p^.vazba;
   if v^.znak>=n1 then begin p1:=p;Break;end;
   p:=p^.dalsi;
   end;
if p1=nil then
   begin
   OKokno('Error','No defined chars in specified range');
   Exit(false);
   end;

{nastavene P mame jeste od predchoziho cyklu}
while p<>nil do
   begin
   v:=p^.vazba;
   if v^.znak<=n2 then p2:=p;
   p:=p^.dalsi;
   end;
if p2=nil then
   begin
   OKokno('Error','No defined chars in specified range');
   Exit(false);
   end;

sva_p1:=FontObjekt^.Svazak^.Kolikaty_ve_Vazniku(p1);
sva_p2:=FontObjekt^.Svazak^.Kolikaty_ve_Vazniku(p2^.dalsi);
end;


Function Poznac_si_znak(vz:PZnakTab):longint;
begin
vz^.vbloku:=not(vz^.vbloku);
Poznac_si_znak:=koOBNOV;
end;


Function Kolik_znaku_je_poznaceno:longint;
var z:PZnakTab;
    i:longint;
begin
i:=0;
FontObjekt^.Svazak^.Reset;
while not FontObjekt^.Svazak^.Konec do
   begin
   z:=FontObjekt^.Svazak^.Nacti;
   if z^.vbloku then inc(i);
   end;
Kolik_znaku_je_poznaceno:=i;
end;



Function VyberRozsahZnaku(tit:string;var n1,n2,ds:longint;var ov:boolean):boolean;
var c1,c2,c3:PCiselnik;
    p1:PCtverecek;
    ok:TOkno_s_tlacitky;
    konec:boolean;
    potr_vyska:longint;
    pr:PPrepinace;

begin
konec:=false;
if ds=0 then potr_vyska:=100 else
if ds>0 then potr_vyska:=150
        else potr_vyska:=170;

ok.Init(NA_STRED,NA_STRED,277,potr_vyska,tit,w_OK+#9+w_CANCEL);

c1:=New(PCiselnik,init(ok.x+3,ok.y+25,n1,0,65535,100{'Lower bound of range'}));
c2:=New(PCiselnik,init(ok.x+3,ok.y+50,n2,0,65535,101{'Upper bound of range'}));

ok.Pridej(c1);
ok.Pridej(c2);

ok.NapisS(c1^.x+93,c1^.y,'<font=cour14.fn>Lower bound of range<sf>');
ok.NapisS(c2^.x+93,c2^.y,'<font=cour14.fn>Upper bound of range<sf>');

if ds>0 then
   begin
   c3:=New(PCiselnik,init(ok.x+3,ok.y+75,ds,1,KRESLITKO_XBUNEK,102));
   ok.Pridej(c3);
   ok.NapisS(c3^.x+93,c3^.y,'<font=cour14.fn>Width for created chars<sf>');

   p1:=New(PCtverecek,Init(ok.x+3,ok.y+100,14,0));
   ok.Pridej(p1);
   ok.NapisS(c3^.x+30,ok.y+100,'<font=cour14.fn>Overwrite existing chars?<sf>');
   end else
if ds<0 then
   begin
   pr:=New(PPrepinace,Init(ok.x+3,ok.y+75,'Surround chars'+#13#10+
                                          'Set char width',1,0));
   ok.Pridej(pr);
   c3:=New(PCiselnik,init(ok.x+153,ok.y+90,sirenka.VratHodnotu,1,KRESLITKO_XBUNEK,0));
   ok.Pridej(c3);
   end;

repeat
ok.Zobraz;
ok.Run;

if ok.hodnota=ww_ok then
   if c1^.Vrathodnotu>c2^.Vrathodnotu
      then OKokno('<barva=51200>Wrong range<sb>',
            'First value must <podtrh=+>not<podtrh=->'#13#10'be greater then second one')
      else begin konec:=true;Break;end
   else Break;
until 1=2;
n1:=c1^.VratHodnotu;
n2:=c2^.VratHodnotu;
if ds>0
   then begin ds:=c3^.VratHodnotu;ov:=p1^.hodnota;end
   else if ds<0 then begin ds:=c3^.VratHodnotu;ov:=pr^.VratByte=1;end
   else ov:=false;

ok.Done;  {uvolni i vsechny vlozene objekty, netreba to delat zvlast}
VyberRozsahZnaku:=konec;
end;


function ObklopeniZnaku:longint;
var n1,n2,n3:longint;
    s1,s2,s:longint;
    p:PZnakTab;
    a,b:boolean;
    u:PUzel;

begin
ObklopeniZnaku:=0;
n1:=0;
n2:=65535;
n3:=-1;  {nezabyvej se dalsimi vymozenostmi navic}
if VyberRozsahZnaku('Set char width',n1,n2,n3,a) then
   begin

   u:=FontObjekt^.Svazak^.First;

   while u<>nil do
      begin
      p:=u^.vazba;
      if p^.znak>=n1 then
         begin
         while u<>nil do
            begin
            p:=u^.vazba;
            if A then FontObjekt^.ObklopZnak(p^.znak)
                 else FontObjekt^.NastavSirkuZnaku(p^.znak,n3);

            if p^.znak>n2 then Break;
            u:=u^.dalsi;
            end;
         Break;
         end;
      u:=u^.dalsi;
      end;


   {b:=ZpracujRozsah(n1,n2,s1,s2);
   if b=true then for s:=s1 to s2 do FontObjekt^.ObklopZnak(s);}
   ObklopeniZnaku:=koOBNOV;
   kreslitko.PriradZnak(kreslitko.znak);
   kreslitko.Zobraz;
   end;
end;


Procedure KontrolaClearGrid;
var a,b:longint;
begin
ClearGrid.kontrola;
if ClearGrid.stav=_aktivni then
   begin
   a:=kreslitko.Znak;
   kreslitko.NovyZnak; {jako vedlejsi efekt zmeni znak na NEDEFINOVANY}
   kreslitko.Znak:=a;
   kreslitko.Zobraz;
   end;
end;


Procedure KontrolaInverseGrid;
var a1,a2,b1,b2,a,b,u:longint;
begin
Inverse_Grid.kontrola;
if Inverse_Grid.stav=_aktivni then
   begin
   Kreslitko.DejOhraniceni(a1,b1,a2,b2);
   for b:=b1 to b2 do
       for a:=a1 to a2 do
           begin
           if Kreslitko.DejBod(a,b)=1 then u:=0 else u:=1;
           Kreslitko.Bod(a,b,u);
           end;
   kreslitko.Zobraz;
   end;
end;


Function ProvedUpdateZnaku:longint;
var pc:PCiselny_dialog;
    b,i:longint;
begin
repeat
   pc:=New(PCiselny_dialog,Init(NA_STRED,NA_STRED,'Specify char code',0,65535,kreslitko.znak));
   pc^.Zobraz;
   pc^.Run;
   b:=pc^.hodnota;
   i:=pc^.tc^.VratHodnotu;
   Dispose(pc,Done);
   if B=ww_zrus then Break;
   if i<>-1 then Exit(FontObjekt^.ZaradZnak(i));
until 1=2;
ProvedUpdateZnaku:=0;
end;


Function KontrolaUpdatuZnaku:longint;
{Dialog vedouci k prekopirovani znaku z kreslitka do definice fontu}
var pc:PCiselny_dialog;
    b,i:longint;
begin
usechar.kontrola;
if usechar.stav=_aktivni then Exit(ProvedUpdateZnaku);
KontrolaUpdatuZnaku:=0;
end;


Function SmazaniJednohoZnaku(jiz_odsouhlaseno:boolean;w:longint):longint;
begin
SmazaniJednohoZnaku:=0;
if jiz_odsouhlaseno or AnoNeOkno('Do you realy want to'#13#10'delete char n. <barva=51200>'+
                                 MyStr(w)+'<sb>?')
   then begin
   FontObjekt^.SmazZnak(w);
   SmazaniJEdnohoZnaku:=koOBNOV;
   kreslitko.NovyZnak;
   kreslitko.Zobraz;
   end;
end;


Function SmazaniViceZnaku(jiz_odsouhlaseno:boolean;i:longint):longint;
var s1:string;
    p:PZnakTab;
    j:longint;

begin
SmazaniViceZnaku:=0;
if jiz_odsouhlaseno or AnoNeOkno('Do you want to delete <barva=51200>'+
                                 MyStr(i)+' <sb>marked chars?<sb>')
   then begin
   FontObjekt^.Svazak^.Reset;
   while not FontObjekt^.Svazak^.Konec do
      begin
      p:=FontObjekt^.Svazak^.Nacti;
      if p^.vbloku=true then
         begin
         j:=p^.znak;
         FontObjekt^.SmazZnak(j,FontObjekt^.Svazak^.nacteny);
         end;
      end;
   SmazaniViceZnaku:=koOBNOV;
   end;
end;


Function Dialog_o_smazani_jednoho_nebo_vice_znaku(w,i:longint):byte;
{vraci [0,1,2]. 0 = cancel, 1 = smaz oznacene, 2 = smaz jeden}
var ok:TOkno_s_tlacitky;
    p:PPrepinace;
    s1:string;
    s2:pchar;
    e:byte;

begin
s1:='<barva=0>Do you want to delete <barva=51200>'+MyStr(i)+' <sb>marked chars?<sb>';
if w<>-1 then s1:=s1+#13#10+'<barva=0>Delete char n. <barva=51200>'+MyStr(w)+'<sb>?<sb>';
s1:=s1+#0;
s2:=@s1[1];

ok.Init(NA_STRED,NA_STRED,390,90,'Delete char',w_OK+#9+w_CANCEL);

p:=New(PPrepinace,Init(ok.x+3,ok.y+28,s2,1,0));

ok.Pridej(p);
ok.Zobraz;
ok.Run;

if ok.hodnota=ww_zrus then e:=0 else
if p^.VratByte=1 then e:=1 else e:=2;

ok.Done;
Dialog_o_smazani_jednoho_nebo_vice_znaku:=e;
end;


Function KontrolaSmazaniZnaku:longint;
var w,i:longint;
    b:byte;
    o:boolean;
begin
KontrolaSmazaniZnaku:=0;
deletechar.kontrola;
if deletechar.stav=_aktivni then
   begin
   o:=false;
   w:=kreslitko.znak;
   i:=Kolik_znaku_je_poznaceno;
   if i>0 then begin b:=Dialog_o_smazani_jednoho_nebo_vice_znaku(w,i);o:=true;end
          else b:=2;

   if b=2 then    {smazani jednoho znaku}
      begin
      if w=-1
         then begin
         kreslitko.NovyZnak;
         kreslitko.Zobraz;
         end
         else KontrolaSmazaniZnaku:=SmazaniJednohoZnaku(o,w);
      end else
   if b=1 then    {smazani vice znaku}
      KontrolaSmazaniZnaku:=SmazaniViceZnaku(true,i);
   end;
end;


Procedure KontrolaSirenky;
begin
sirenka.kontrola;
if sirenka.byla_zmena then
   begin
   kreslitko.Ohraniceni;
   kreslitko.Zobraz;
   end;
end;


Procedure KontrolaSwapu;
begin
swaphorz.kontrola;
if swaphorz.stav=_aktivni then
   begin
   Kreslitko.SwapHorz;
   Kreslitko.Zobraz;
   end;

swapvert.kontrola;
if swapvert.stav=_aktivni then
   begin
   Kreslitko.SwapVert;
   Kreslitko.Zobraz;
   end;
end;


Procedure KontrolaPosunu;
var b:boolean;
begin
Posun_H.kontrola;
Posun_L.kontrola;
Posun_D.kontrola;
Posun_P.kontrola;
b:=true;
if Posun_H.stav=_aktivni then Kreslitko.PosunBody(0,-1,0) else
if Posun_D.stav=_aktivni then Kreslitko.PosunBody(0,1,0) else
if Posun_L.stav=_aktivni then Kreslitko.PosunBody(-1,0,0) else
if Posun_P.stav=_aktivni then Kreslitko.PosunBody(1,0,0) else b:=false;
if b=true then Kreslitko.Zobraz;
end;


Function KontrolaEmptyChars:longint;
var ok:Tokno_s_tlacitky;
    n1,n2,n3:longint;
    a:longint;
    b,c:boolean;
begin
KontrolaEmptyChars:=0;
EmptyChars.kontrola;
if EmptyChars.stav=_aktivni then
   begin
   n1:=0;
   n2:=255;
   n3:=sirenka.VratHodnotu;
   if VyberRozsahZnaku('Create empty chars',n1,n2,n3,b) then
      begin
      for a:=n1 to n2 do
          begin
          c:=FontObjekt^.fnf^.znak^[a].data<>nil;
          if (b=true) or (c=false) then
             begin
             if c=true then FontObjekt^.SmazZnak(a);

             FontObjekt^.VytvorPrazdnyZnak(a,n3);
             FontObjekt^.Svazak_VlozZnak(a);
             end;
          end;
      KontrolaEmptyChars:=koOBNOV;
      end;
   end;
end;


Procedure KontrolaRotatoru;
begin
RotLeft.Kontrola;
if RotLeft.stav=_aktivni then
   begin
   Kreslitko.Rotace_L(0);
   Kreslitko.Zobraz;
   end;

RotRight.Kontrola;
if RotRight.stav=_aktivni then
   begin
   Kreslitko.Rotace_P(0);
   Kreslitko.Zobraz;
   end;
end;


Constructor TOknoZakladniLinky.Init(ix,iy:longint;s,t:string);
begin
basestr:=t;
inherited init(NA_STRED,NA_STRED,ix,iy,s,w_OK+#9+w_CANCEL);
Roztahni(ix,iy);

nat:=New(PTlacitko2,Init(x+5,y+25,'',@HSipka_obrazek,@HSipka_obrazek,$FFFF,100));
dot:=New(PTlacitko2,init(x+nat^.sirka+5,y+25,'',@DSipka_obrazek,@DSipka_obrazek,$FFFF,101));
Pridej(nat);
Pridej(dot);
linka:=FontObjekt^.fnf^.so;
end;


Procedure TOknoZakladniLinky.UkazNastaveniLinky;
var v,v2:virtualwindow;
    ih,iv,j:longint;
    b:boolean;
    myfnf:Pfont;
begin
Init_VW(v,135,20,false);
Clr(v,BA_TLA_v);
NastavVystup(@v);
myfnf:=FontObjekt^.fnf;
Print_FNTag(0,14,'<barva=0>up/down: '+mystr(linka)+'/'+mystr(FontObjekt^.vfh-linka)+'<sb>',myfnf);

if Jsou_def_znaky_FN(basestr,myfnf)=0 then
   begin
   ih:=210;
   iv:=Vyska_FN(myfnf)+10;
   b:=true;
   end
   else begin
   ih:=343;
   iv:=54;
   b:=false;
   end;

Init_VW(v2,ih,iv,false);
clr(v2,BA_TLA_v);
NastavVystup(@v2);

if b=true then begin
          j:=Sirka_FN(basestr,myfnf);
          LineHorz(v2,0,j,linka,60000);
          Print_FNTag(0,myfnf^.so,basestr,myfnf);
          end
          else Print_FNTag(0,16,'There aren''t defined chars'#13#10'for testing string:'+
                       '<barva=51200>'+basestr+'<sb>'#13#10+
                       'However you can set the baseline anyway',myfnf);

MouseHide;
PutClippedSprite(vga,v2,x+5,y+45);
PutClippedSprite(vga,v,x+50,y+25);
MouseShow;
NastavVystup(@vga);
Kill_VW(v2);
Kill_VW(v);
end;



Procedure TOknoZakladniLinky.Akce(var i:longint);
begin
if i=100 then dec(linka) else
if i=101 then inc(linka) else Exit;
UkazNastaveniLinky;
end;


Destructor TOknoZakladniLinky.Done;
begin
inherited Done;
end;


Function BudemeMenitZakladniLinku:longint;
var ok:TOknoZakladniLinky;
    nat,dot:PTlacitko;
    mybasestr:string;
    myfnf:PFont;

begin
mybasestr:='Baby jagy';
BudemeMenitZakladniLinku:=0;
myfnf:=FontObjekt^.fnf;

if Jsou_def_znaky_FN(mybasestr,myfnf)=0
   then ok.init(350,80+Vyska_FN(myfnf),'Setting the baseline',mybasestr)
   else ok.init(350,125,'Setting the baseline',mybasestr);

ok.Zobraz;
ok.UkazNastaveniLinky;
ok.Run;
if (ok.hodnota=ww_OK) and (ok.linka<>myfnf^.so) then
   begin
   myfnf^.so:=ok.linka;
   myfnf^.su:=FontObjekt^.vfh-ok.linka;
   FontObjekt^.svazak^.For_each(@Prenes_SO_na_znaky);
   kreslitko.Zobraz;
   BudemeMenitZakladniLinku:=koOBNOV;
   end;
ok.Done;
end;


Function Konverze_ASCII_unicode:longint;
var s:string;
    pr:boolean;
begin
pr:=true;
s:=Vyber_TBL_soubor_okno(pr);
if (s='') or (s='[nic]') then Exit(0);
FontObjekt^.Prekoduj_z_ASCII_do_UNI(s,1,pr);  {1=smer ASCII->uni}
Konverze_ASCII_unicode:=koOBNOV;
end;


Function Konverze_unicode_ASCII:longint;
var s:string;
    pr:boolean;
begin
pr:=true;
s:=Vyber_TBL_soubor_okno(pr);
if (s='') or (s='[nic]') then Exit(0);
FontObjekt^.Prekoduj_z_ASCII_do_UNI(s,2,pr);  {2=smer uni->ASCII}
Konverze_unicode_ASCII:=koOBNOV;
end;


Function GlobalFontSettings:longint;
var j,i:longint;
begin
j:=0;
i:=Nabidka(global_font_settings.x,
           global_font_settings.y,
             'Change font height'+#13#10+       {1}
             'Set char size'+#13#10+            {2}
             'Char distance'+#13#10+            {3}
             'Set basic line'+#13#10+           {4}
             'Conversion ASCII-unicode'+#13#10+ {5}
             'Conversion unicode-ASCII',        {6}
              883,0,ba_vyb_v_sti);
case i of
  1:j:=BudemeMenitVyskuFontu;
  2:j:=ObklopeniZnaku;
  3:j:=DistanceMeziZnaky;
  4:j:=BudemeMenitZakladniLinku;
  5:j:=Konverze_ASCII_unicode;
  6:j:=Konverze_unicode_ASCII;
  end; {case}
GlobalFontSettings:=j;
end;


Function KontrolaGlobalFontSettings:longint;
begin
KontrolaGlobalFontSettings:=0;
global_font_settings.Kontrola;
if Global_Font_settings.stav=_aktivni then
   KontrolaGlobalFontSettings:=GlobalFontSettings;
end;


Function Cislo_okno_s_undefined:longint;
var ok:TOkno_s_tlacitky;
    ci:PCiselnik;
    tex,tey:longint;
    h,z,i:longint;

begin
tex:=TlacitkoEditedChar.x;
tey:=TlacitkoEditedChar.y;

ok.Init(tex-100,tey,230,80,'Edited char',w_ok+#9+w_cancel+#9+
                       '<BARVA=*;KLAVESY=uU;VYZNAM=-2>U<SB>ndefined');

if kreslitko.znak=-1 then z:=0 else z:=kreslitko.znak;
ci:=New(PCiselnik,Init(ok.x+3,ok.y+30,z,0,65535,0));

ok.Pridej(ci);

ok.Zobraz;
ok.Run;

h:=ok.hodnota;
i:=ci^.VratHodnotu;


ok.Done;

if h=-2 then Exit(-1);              {kod undefined}
if h=-3 then Exit(kreslitko.znak);  {kliklo se na cancel, tedy nic nemenim}

Cislo_okno_s_undefined:=i;
end;


Procedure KontrolaTlacitkaEditedChar;
var i:longint;
    j:longint;
begin
TlacitkoEditedChar.Kontrola;
if TlacitkoEditedChar.stav=_aktivni then
   begin
   j:=Kreslitko.Znak;
   i:=Cislo_okno_s_undefined;
   Kreslitko.Znak:=i;
   Kreslitko.Zobraz;
   end;
end;


Procedure Proved_Transfer_znaku(zdr,kam:byte;prepisovat:boolean);
var zal:pointer;
    zdrf,kamf:PFontObjekt;
    v:PZnakTab;
    i:longint;

begin
zal:=FontObjekt;
FontObjekt:=@FontObjekty[zdr];


zdrf:=@FontObjekty[zdr];
kamf:=@FontObjekty[kam];


global_debug_count:=0;

zdrf^.Svazak^.Reset;
while not zdrf^.Svazak^.Konec do
   begin
   v:=zdrf^.Svazak^.Nacti;
   i:=v^.znak;
   if v^.vbloku then zdrf^.TransferujZnak(kam,i,prepisovat);
   end;
FontObjekt:=zal;
end;


Function Prevod_AB(a,b:byte):byte;
var i,j:byte;
begin
i:=0;j:=0;
repeat
inc(i);
if i<>b then inc(j);
until j=a;
Prevod_AB:=i;
end;


Function Dialog_k_transferu_znaku(i:longint):longint;
var ok:tOkno_s_tlacitky;
     a,b:byte;
    p:PPrepinace;
    c:PCtverecek;
    s:string;

begin
Dialog_k_transferu_znaku:=0;
ok.init(NA_STRED,NA_STRED,270,170,'Transfer chars',w_OK+#9+w_cancel);
ok.NapisS(ok.x+3,ok.y+28,'Where do you want to transfer'+#13#10+
                        '<BARVA=51200>'+mystr(i)+'<sb> chars to?');

s:='';
for a:=1 to POCET_SLOTU_NA_FONTY do
   begin
   if FontObjekt<>@FontObjekty[a] then s:=s+'Font No. '+MyStr(a)+#13#10
      else b:=a;  {a zjistili jsme i aktualni blok znaku}
   end;
dec(char(s[0]),2);  {elegantni odriznuti 2 posl. bajtu retezce}
s:=s+#0;
p:=New(PPrepinace,Init(ok.x+15,ok.y+67,@s[1],1,0));
ok.Pridej(p);
c:=New(PCtverecek,Init(ok.x+5,ok.y+121+3,10,0));
ok.Pridej(c);
ok.NapisS(ok.x+20,ok.y+121,'Overwrite existing chars?');
ok.Zobraz;
ok.Run;

if ok.hodnota<>ww_zrus then
   begin
   a:=Prevod_AB(p^.VratByte,b);
   Proved_Transfer_znaku(b,a,c^.hodnota);
   Dialog_k_transferu_znaku:=koOBNOV;
   end;

ok.Done;
end;


Function KontrolaTransferuZnaku:longint;
var i:longint;
begin
KontrolaTransferuZnaku:=0;
transferchars.kontrola;
if transferchars.stav=_aktivni then
   begin
   i:=Kolik_znaku_je_poznaceno;
   if i=0 then OKokno(' ','There are no marked chars to transfer.')
      else KontrolaTransferuZnaku:=Dialog_k_transferu_znaku(i);
   end;
end;


Function KontrolaPrepinacuFontObjekt:longint;
var a,b:byte;
begin
KontrolaPrepinacuFontObjekt:=0;
b:=FontObjekt_num;
for a:=1 to POCET_SLOTU_NA_FONTY do
    begin
    FontObjTla[a].kontrola;
    if (FontObjTla[a].stav=_aktivni) and (a<>b)
       then Exit(koZMENA_FONT_OBJ_PREFIX+a);
    end;
end;


Function ZkontrolujDalsiObjekty(v:virtualwindow):longint;
var i:longint;
begin
ZkontrolujDalsiObjekty:=0;
i:=menu^.kontrola;
if i<>0 then Exit(AktivaceMenu(i));
kreslitko.kontrola;
KontrolaSirenky;
KontrolaSwapu;
KontrolaRotatoru;
KontrolaClearGrid;
KontrolaInverseGrid;
KontrolaPosunu;
KontrolaTlacitkaEditedChar;

i:=KontrolaPrepinacuFontObjekt;if i<>0 then Exit(i);
i:=KontrolaGlobalFontSettings;if i<>0 then Exit(i);
i:=KontrolaEmptyChars;if i<>0 then Exit(i);
i:=KontrolaUpdatuZnaku;if i<>0 then Exit(i);
i:=KontrolaSmazaniZnaku;if i<>0 then Exit(i);
i:=KontrolaTransferuZnaku;if i<>0 then Exit(i);
end;

Procedure NovyProjekt;
begin
FontObjekt^.SmazVse;
FontObjekt^.NewFont;
sirenka.VlozHodnotu(DEFAULTNI_SIRKA_ZNAKU);
kreslitko.NovyZnak;
kreslitko.Zobraz;
end;


Function PotvrdKonec:longint;
begin
if AnoNeOkno('Are you sure?') then Exit(koJISTYKONEC) else Exit(0);
end;


Procedure Vykresli_Detaily_prostredi;
var s:string;
    ofnc:longint;
begin
MouseHide;
_PrazdnyBox(0,0,menu^.x1,21,BA_VYB_LH,BA_VYB_PD);
Bar(vga,1,1,menu^.x1,20,BA_VYB_V);
PutPixel(vga,menu^.x1,0,BA_VYB_LH);

ofnc:=FN_color;
FN_color:=21;


if FontObjekt^.fnt=''
   then s:='file: <BARVA=47712><<unnamed>><SB>   '
   else s:='file: <BARVA=47712>'+FontObjekt^.fnt+'<SB>   ';

s:=s+'height: <BARVA=47712>'+myStr(FontObjekt^.vfh)+'<SB>  ';
s:=s+'Defined chars: <BARVA=47712>'+MyStr(FontObjekt^.fnf^.poc_znaku)+'<SB>';

Print_FNtag(4,18,s,fn_vga16);
FN_color:=ofnc;


Ukaz_Stav_Tlacitek_FontObj_tla;
MouseShow;
end;


Procedure TFontObjekt.Priprav_na_zobrazeni;
{Pripravi zobrazovaci platno, t.j. vyrez VW s kompletne vykreslenym fontem}
var a,b,i,j:longint;
    smz,vmz:longint;
begin
Vykresli_Detaily_prostredi;

i:=abs(fnf^.maxpred)+abs(fnf^.maxza);
j:=abs(fnf^.maxnad)+abs(fnf^.maxpod)+(mmm^.so+mmm^.su)*2;
if i<prostor_pro_text_FFFFh_v_mmm_fontu+4
   then i:=prostor_pro_text_FFFFh_v_mmm_fontu+4;


if fnf^.unicode then Prirad_do_svazaku_souradnice(i,j,a,b);

smz:=SIRKA_MAPY_ZNAKU;
vmz:=VYSKA_MAPY_ZNAKU;

if a<smz-16 then a:=smz-16;
if b<vmz-6 then b:=vmz-6;
Init_VW(pro_vw,a,b,false);
clr(pro_vw,742);
VykresliBunky(pro_vw);    {a mame vykreslenou celou mapu znaku do virt. okna}
vw:=New(PVyrez,Init(POLOHA_MAPY_ZNAKU_X,POLOHA_MAPY_ZNAKU_Y,smz,vmz,@pro_vw,0));
end;


Function Je_uz_nejaky_znak_poznaceny:longint;
var z:PZnakTab;
begin
FontObjekt^.Svazak^.Reset;
while not FontObjekt^.Svazak^.Konec do
   begin
   z:=FontObjekt^.Svazak^.Nacti;
   if z^.vbloku then Exit(z^.znak);
   end;
Je_uz_nejaky_znak_poznaceny:=-1;
end;


Function Odznac_vsechny_znaky:longint;
var z:PZnakTab;
begin
FontObjekt^.Svazak^.Reset;
while not FontObjekt^.Svazak^.Konec do
   begin
   z:=FontObjekt^.Svazak^.Nacti;
   if z^.vbloku then z^.vbloku:=false;
   end;
Odznac_vsechny_znaky:=koOBNOV;
end;


Function Oznac_blok_znaku(b,v:word):longint;
var i,j,a:word;
    z:PZnakTab;
begin
if b<v
   then begin i:=b;j:=v;end
   else begin i:=v;j:=b;end;

FontObjekt^.Svazak^.Reset;
while not FontObjekt^.Svazak^.konec do
   begin
   z:=FontObjekt^.Svazak^.nacti;
   if z^.znak=i then
      begin
      repeat
      a:=z^.znak;
      z^.vbloku:=true;
      z:=FontObjekt^.Svazak^.nacti;
      until (a=j) or (FontObjekt^.Svazak^.konec);
      Exit(koOBNOV);
      end;
   end;
Oznac_blok_znaku:=koOBNOV;
end;


Function MapaZnaku_Akce_PravehoMysitka(mx,my:longint;vz:PZnakTab):longint;
var i:byte;
    b,j,e,k:longint;
    n1,n2,n3,n4,n5,ss:string;

begin
j:=0;
if vz=nil then
   begin
   i:=Nabidka(mx,my,'New char'+#13#10+
                    'Cancel');

   if i=1 then j:=ProvedUpdateZnaku else j:=0;
   end
   else
   begin
   if vz^.vbloku then
      begin
      n1:='Unmark char<VYZNAM=4>'+#13#10;
      n2:='Unmark all<VYZNAM=5>'+#13#10;
      n4:='Delete marked chars<VYZNAM=7>'+#13#10;
      end
      else begin
      b:=Je_uz_nejaky_znak_poznaceny;
      n1:='Mark char<VYZNAM=2>'+#13#10;
      if b<>-1
         then begin
              n2:='Mark block of chars<VYZNAM=3>'+#13#10;
              n4:='Delete marked chars<VYZNAM=7>'+#13#10;
              end
         else begin n2:='';n4:='';end;
      end;

   n3:='Delete one char<VYZNAM=6>'+#13#10;
   n5:='Cancel<VYZNAM=10>';

   ss:=n1+n2+n3+n4+n5;

   Nabidka(mx,my,ss,e); {Alternativni zpusob zjistovani polozky.}
                        {Nebudu zjistovat poradi polozky, ale hodnotu jejiho}
                        {tagu VYZNAM}

   case e of
   2: j:=Poznac_si_znak(vz);  {zde ve vyznamu zaznaceni}
   3: j:=Oznac_blok_znaku(b,vz^.znak);
   4: j:=Poznac_si_znak(vz);  {zde ve vyznamu odznaceni}
   5: j:=Odznac_vsechny_znaky;
   6: j:=SmazaniJednohoZnaku(false,vz^.znak);  {smaz jeden znak}
   7: begin
      k:=Kolik_znaku_je_poznaceno;
      j:=SmazaniViceZnaku(false,k);  {smaz vice znaku}
      end;
   10:j:=0;
   else j:=0;
   end; {case}
   end;
if j<>0 then j:=koOBNOV;
MapaZnaku_Akce_PravehoMysitka:=j;
end;



Function MapaZnaku:longint;
var a,b,i,j:longint;
    sx,sy,sb,mx,my,mb,mxx,myy:longint;
    kod:longint;
    kp:pchar;
    ks:string;
    hv:boolean;
    vz,ovz:PZnakTab;
    myvw:PVyrez;
    v:PVirtualwindow;

begin
kod:=0;
myvw:=FontObjekt^.vw;    {zkratka v vyrezu}
v:=@FontObjekt^.pro_vw;  {zkratka pro vyrezovou bitmapu}
myvw^.zobraz;

sx:=-1;
sy:=-1;
sb:=-1;
ovz:=nil;

repeat
HlidejKlavesy;
myvw^.kontrola;
mx:=mouse.x;
my:=mouse.y;
mb:=mouse.b;
if ((mx<>sx) or (my<>sy) or (mb<>sb)) and (kod=0) then
   begin
   sx:=mx;
   sy:=my;
   sb:=mb;
   if Uvnitr(mx,my,myvw^.x,myvw^.y,myvw^.x+myvw^.sirka-17,myvw^.y+myvw^.vyska-17)
      then begin
      mxx:=mx-myvw^.x+myvw^.poc_ZobrX;
      myy:=my-myvw^.y+myvw^.poc_ZobrY;
      vz:=FontObjekt^.Urci_znak_v_tabulce(mxx,myy);
      if (vz<>nil) then     {VZ by NIL nemelo byt nikdy}
         begin
         if vz<>ovz then
            begin
            if ovz<>nil then FontObjekt^.NakresliBunku(ovz,false,v^);
            FontObjekt^.NakresliBunku(vz,true,v^);
            myvw^.Zobraz;
            end;

         if mb=1 then
            begin
            kreslitko.PriradZnak(vz^.znak);
            kreslitko.Zobraz;
            end;
         ovz:=vz;
         end;
      if mb=2 then kod:=MapaZnaku_Akce_PravehoMysitka(mx,my,vz);
      end
      else vz:=nil;
   end;

if Je_Klavesa then
   case xKlavesa.ascii of
      xESC:kod:=koKONEC;
      xF1:kod:=koNOVY;
      xF2:kod:=koFILES_SAVE;
      xF3:kod:=koFILES_LOAD;
      xF10:kod:=AktivaceMenu(0);
   end;

if kod=0 then kod:=ZkontrolujDalsiObjekty(v^);
until kod<>0;

MouseRel;
MouseHide;
PutClippedSprite(vga,schovane_pozadi,POLOHA_MAPY_ZNAKU_X,POLOHA_MAPY_ZNAKU_Y);
MouseShow;

MapaZnaku:=kod;
end;


Function Porovnej_PZnakTab(p,q:pointer):boolean;
{porovnejproc:=p<q}
var pp,qq:PZnakTab;
begin
pp:=p;
qq:=q;
Porovnej_PZnakTab:=pp^.znak<qq^.znak;
end;


Constructor TFontObjekt.Init;
begin
fnf:=nil;
svazak:=nil;
vw:=nil;
NewFont;
end;


Procedure TFontObjekt.Novy_Prazdny_Svazak;
begin
Vaznik_Done_All(svazak,@ZnicZnakTab);
svazak:=New(PVaznik,Init);
svazak^.porovnejproc:=@Porovnej_PZnakTab;
end;


Procedure TFontObjekt.NewFont;
var i:longint;
begin
New(fnf);
fnf^.rez:='';
fnf^.vnitrnijmeno:=nil;
fnf^.first:=0;
fnf^.last:=65535;
fnf^.poc_znaku:=0;
fnf^.so:=DEFAULTNI_VYSKA_FONTU;
fnf^.su:=0;
fnf^.add:=0;
fnf^.maxpred:=0;
fnf^.maxza:=DEFAULTNI_SIRKA_ZNAKU+1;
fnf^.maxnad:=-DEFAULTNI_VYSKA_FONTU;
fnf^.maxpod:=0;
fnf^.unicode:=true;
fnf^.komp:=true;
GetMem(fnf^.znak,65536*sizeof(znakdef));
for i:=fnf^.first to fnf^.last do fnf^.znak^[i].data:=nil;
{vyridili (vynulovali) jsme surova data fontu a ted zpracujeme aplikacni veci}
fnt:='';
defch:=0;
Novy_Prazdny_Svazak;
end;


Function TFontObjekt.VFH:byte;
begin
if fnf=nil then vfh:=0 else vfh:=fnf^.so+fnf^.su;
end;


Procedure TFontObjekt.NactiFont(s:string);
begin
if s='' then
   begin
   s:=VyberSouborOkno('Choose a unicode font',exedir+'fonty\*.UFN','UFN',350,1);
   if s='' then Exit;
   end else if not ExistFile(s) then Exit;
   s:=StripNameExt(s);

if ZkontrolujUnicodeFormat(s) then
   begin
   SmazVse;                 {automaticky zlikviduje stary}
   fnt:=s;
   Nacti_FN(fnt,fnf);
   Data_do_noveho_svazaku;
   kreslitko.Clr(0);
   kreslitko.Ohraniceni;
   kreslitko.Zobraz;
   end else OKokno('Error!','This is not an unicode'#13#10'font file in UFN format!');
end;


Function TFontObjekt.DefZnak(i:longint):boolean;
begin
DefZnak:=fnf^.znak^[i].data<>nil;
end;


Procedure TFontObjekt.UlozFont;
var s,m:string;
begin
if fnt='' then m:='newfont.ufn' else m:=fnt;
s:=UlozSouborOkno('Enter filename',GetFontAdr+m,300,false);
if s<>'' then
   begin
   UlozUnicodeFont(fnf,s);
   fnt:=StripNameExt(s);
   end;
end;


Procedure TFontObjekt.RozpakujZnak(w:word;var v:virtualwindow);
var dw:longint;
begin
dw:=fnf^.znak^[w].dp;
Init_VW(v,fnf^.znak^[w].sirka,fnf^.znak^[w].vyska,true);
PutChar_FN(v,fnf^.znak^[w].data,0,0,fnf^.znak^[w].sirka,fnf^.znak^[w].vyska,dw,COMP_DECOMP);
end;


Procedure TFontObjekt.SpakujZnak(v:virtualwindow;w:word;zcela_novy:boolean);
var j,k,n:longint;
    buffer:array[1..KRESLITKO_YBUNEK*KRESLITKO_XBUNEK+8] of byte;
    b:byte;
    q:Pbyte;
begin
FillChar(buffer,{(j+8)}sizeof(buffer),0);
MakeSpriteMap(v,buffer,COMP_DECOMP);
if zcela_novy then
   PripravNedefinovanyZnak(w,v.breite,v.hoehe);
j:=fnf^.znak^[w].dp;

q:=fnf^.znak^[w].data;
n:=1;
for k:=1 to j do
    begin
    b:=(buffer[n+0] shl 7) or (buffer[n+1] shl 6) or (buffer[n+2] shl 5) or
       (buffer[n+3] shl 4) or (buffer[n+4] shl 3) or (buffer[n+5] shl 2) or
       (buffer[n+6] shl 1) or (buffer[n+7] shl 0);
    q^:=b;
    inc(q);
    inc(n,8);
    end;
end;


Procedure TFontObjekt.PripravNedefinovanyZnak(w,sirka,vyska:longint);
var i,j:longint;
      p:pointer;
begin
i:=sirka*vyska;
j:=i div 8;
if i mod 8<>0 then inc(j);  {definice komprimovane bitmapy bude mit J bajtu}


GetMem(fnf^.znak^[w].data,j);    {pripravime prostor pro bitmapu}

fnf^.znak^[w].dp:=j;
fnf^.znak^[w].sirka:=sirka;
fnf^.znak^[w].relx:=0;
fnf^.znak^[w].rely:={-fnf^.so}-vyska;
fnf^.znak^[w].shift:=sirka+2;
fnf^.znak^[w].vyska:=vyska;
end;


Procedure Konverze_velikosti_bitmapy_vert(var zd,cl:Virtualwindow;nvfh:byte);
{ZD musi existovat, CL vytvori (vcetne alokace}
var j:byte;
begin
if nvfh>zd.hoehe then
      begin
      {Male znaky zvetsit}
      j:=(nvfh-zd.hoehe) div 2;
      Init_VW(cl,zd.breite,nvfh,true);
      PutClippedSprite(cl,zd,0,j);
      end
      else begin  {pripad rovnosti resim nemusim, protoze to se sem nedostane}
      {Velke znaky zmensit}
      j:=(zd.hoehe-nvfh{??}) div 2;
      Init_VW(cl,zd.breite,nvfh,true);
      GetClippedSprite(zd,cl,0,j);
      end;
end;


Procedure Konverze_velikosti_bitmapy_horz(var zd,cl:Virtualwindow;nsrh:byte);
{ZD musi existovat, CL vytvori (vcetne alokace}
var j:byte;
begin
if nsrh>zd.breite then
      begin
      {Uzke znaky rozsirit}
      j:=(nsrh-zd.breite) div 2;
      Init_VW(cl,nsrh,zd.hoehe,true);
      PutClippedSprite(cl,zd,j,0);
      end
      else begin  {pripad rovnosti resim nemusim, protoze to se sem nedostane}
      {Siroke znaky zuzit}
      j:=(zd.breite-nsrh) div 2;
      Init_VW(cl,nsrh,zd.breite,true);
      GetClippedSprite(zd,cl,j,0);
      end;
end;



Procedure TFontObjekt.VytvorPrazdnyZnak(w:word;sirka:byte);
begin
if fnf^.znak^[w].data<>nil then FreeMem(fnf^.znak^[w].data);
PripravNedefinovanyZnak(w,sirka,vfh);              {nedefinovana data v znaku}
FillChar(fnf^.znak^[w].data^,fnf^.znak^[w].dp,0);  {a ted je vycistim}
end;


Procedure TFontObjekt.TransferujZnak(kam:byte;i:longint;prepisovat:boolean);
var kamf:PFontObjekt;
    zd,cl:virtualwindow;
    f:PFont;
begin
kamf:=@FontObjekty[kam];
if kamf^.fnf^.znak^[i].data<>nil then
   begin
   if prepisovat=true then kamf^.SmazZnak(i)
                      else Exit;
   end;

inc(kamf^.fnf^.poc_znaku);

if vfh<>kamf^.vfh then   {Slozitejsi pripad - musim menit vysku znaku}
   begin


   RozpakujZnak(i,zd);
   Konverze_velikosti_bitmapy_vert(zd,cl,kamf^.vfh);

   kamf^.SpakujZnak(cl,i,true);   {kterou musim zpetne zapakovat}
   Kill_VW(cl);
   Kill_VW(zd);

   end
   else begin            {Jednodussi pripad beze zmeny vysky znaku}
   kamf^.PripravNedefinovanyZnak(i,fnf^.znak^[i].sirka,fnf^.znak^[i].vyska);
   Move(fnf^.znak^[i].data^,kamf^.fnf^.znak^[i].data^,fnf^.znak^[i].dp);
   end;


kamf^.Svazak_VlozZnak(i);
end;


Procedure TFontObjekt.ZmenaVyskyZnaku(w:longint;nvfh:byte);
var zd,cl:VirtualWindow;
begin
RozpakujZnak(w,zd);        {rozpakuji znak - bitmapu ZD si to vytvori samo}
Konverze_velikosti_bitmapy_vert(zd,cl,nvfh);  {Samo vytvori CL}
Dealokuj_pamet_pro_Znak(w);
SpakujZnak(cl,w,true);     {znak musim zpetne zapakovat z pripravene bitmapy}
Kill_VW(cl);
Kill_VW(zd);
end;


Procedure TFontObjekt.ZmenaVyskyFontu(nvfh:byte);
{Funguje tak, ze znak zapise na neviditelnou bitmapu. Pak se grafickymi
 procedurami zvetsi nebo zmensi platno (resp. bitmapa) a pak se zpetne nactou
 jakoby pres GetPixel jednotlive pixely znaku a zpetne se zpakuje do nativniho
 formatu}
var p:PUzel;
    zn:PZnakTab;
    i:word;

begin
p:=svazak^.first;
while p<>nil do
   begin
   zn:=p^.vazba;
   i:=zn^.znak;
   ZmenaVyskyZnaku(i,nvfh);
   p:=p^.dalsi;
   end;
fnf^.so:=nvfh;
fnf^.su:=0;
fnf^.maxnad:=-nvfh;
end;


Procedure TFontObjekt.ObklopZnak(i:longint);
var v,v2:virtualwindow;
    x,y,x1,x2:longint;
    k:boolean;

begin
RozpakujZnak(i,v);
k:=false;
x1:=-1;
for x:=0 to v.breite-1 do
    begin
    for y:=0 to v.hoehe-1 do
        if GetPixel(v,x,y)<>0 then begin x1:=x;k:=true;Break;end;
    if K then Break;
    end;
if x1=-1 then      {vsechny pixely jsou prazdne?}
   begin           {v takovem pripade nedelej nic}
   Kill_VW(v);
   Exit;
   end;
k:=false;
for x:=v.breite-1 downto 0 do
    begin
    for y:=0 to v.hoehe-1 do
        if GetPixel(v,x,y)<>0 then begin x2:=x;k:=true;Break;end;
    if K then Break;
    end;
Init_VW(v2,x2-x1+1,v.hoehe,false);
GetClippedSprite(v,v2,x1,0);
Dealokuj_pamet_pro_znak(i);
SpakujZnak(v2,i,true);
Kill_VW(v2);
Kill_VW(v);
end;


Procedure TFontObjekt.NastavSirkuZnaku(i:longint;b:byte);
var v,v2:virtualwindow;
    x,y,x1,x2:longint;
    k:boolean;

begin
RozpakujZnak(i,v);
Konverze_velikosti_bitmapy_horz(v,v2,b);
Dealokuj_pamet_pro_znak(i);
SpakujZnak(v2,i,true);
Kill_VW(v2);
Kill_VW(v);
end;


Procedure TFontObjekt.Prirad_do_svazaku_souradnice(i,j:longint;var a,b:longint);
{Netvori nove oplozky do svazaku, ale priraduje jim souradnice
 (priprava pred vykreslenim na obrazovku)}
var e,f,k:longint;
    v:PZnakTab;
begin
a:=0;
b:=0;
e:=0;
f:=0;
v:=nil;
k:=0;
svazak^.Reset;
while not svazak^.konec do
   begin
   v:=svazak^.nacti;
   v^.x1:=e;
   v^.y1:=f;
   v^.x2:=e+i;
   v^.y2:=f+j;
   inc(e,i);
   inc(k);
   if k mod 16=0 then
      begin
      a:=v^.x2+1;
      e:=0;
      inc(f,j);
      end;
   end;
if v<>nil then b:=v^.y2+1;
end;


Procedure TFontObjekt.Data_do_noveho_svazaku;
{Do svazaku nahraje odkazy na vsechny definovane znaky.
 V tuto chvili neresi souradnice na obrazovce.
 Predtim automaticky zlikviduje stary svazak.}
var k,n:longint;
    v:PZnakTab;
begin
Novy_Prazdny_Svazak;
n:=-1;
k:=0;
repeat
inc(n);
if fnf^.znak^[n].data<>nil then
   begin
   New(v);
   v^.znak:=n;
   v^.vbloku:=false;
   svazak^.InitNext(v);
   inc(k);
   end;
until (k>=fnf^.poc_znaku) or (n=65535);
end;


Procedure TFontObjekt.NakresliBunku(n:PZnakTab;prosvicena:boolean;v:virtualwindow);
var e:word;
    aa,dw,i:longint;
    s:string;
    pop,pop2,poz,poz2,ppoz:word;
begin
if prosvicena then
   begin
   pop:=655;
   pop2:=25356;
   poz:=7;
   poz2:=57;
   end
   else begin
   pop:=65535;
   pop2:=330;
   poz:=1234;
   poz2:=557;
   end;
if n^.vbloku then ppoz:=poz2 else ppoz:=poz;

NastavVystup(@v);
e:=n^.znak;
Rectangle(v,n^.x1,n^.y1,n^.x2,n^.y2,65535);
i:=(n^.x1+n^.x2) div 2;
if fnf^.znak^[e].data=nil then Bar(v,n^.x1+1,n^.y1+1,n^.x2-1,n^.y2-1,742)
   else begin
   Bar(v,n^.x1+1,n^.y1+1,n^.x2-1,n^.y2-1,ppoz);
   FN_color:=pop;
   aa:=i-(fnf^.znak^[e].sirka div 2);
   dw:=fnf^.znak^[e].dp;
   PutChar_FN(v,fnf^.znak^[e].data,aa,n^.y1+2,fnf^.znak^[e].sirka,fnf^.znak^[e].vyska,dw,pop);
   end;
FN_color:=pop2;
s:=Mystr(e);
aa:=Sirka_FN(s,mmm) div 2;
Print_FN(i-aa,n^.y2-mmm^.so,s,mmm);
s:=Dec2Hex(e)+'h';
aa:=Sirka_FN(s,mmm) div 2;
Print_FN(i-aa,n^.y2-1,s,mmm);

NastavVystup(@vga);
end;


Procedure TFontObjekt.VykresliBunky(v:virtualwindow);
var q:PUzel;
    e:PZnakTab;
begin
q:=svazak^.first;
while q<>nil do
   begin
   e:=q^.vazba;
   NakresliBunku(e,false,v);
   q:=q^.dalsi;
   end;
end;


Function TFontObjekt.Urci_znak_v_tabulce(mx,my:longint):PZnakTab;
var v:PZnakTab;
begin
svazak^.reset;
while not svazak^.konec do
   begin
   v:=svazak^.nacti;
   if Uvnitr(mx,my,v^.x1,v^.y1,v^.x2,v^.y2) then Exit(v);
   end;
Exit(nil);
end;


Function TFontObjekt.Svazak_SmazZnak(i:longint):boolean;
var v:PZnakTab;
    u:PUzel;
begin
{Preferencne pouzivam vysokourovnejsi Svazak^.Reset ... Svazak^.Nacti, ale
 zde je to rizikove, protoze by se toto ruseni znaku mohlo nachazet jako
 vnorene uvnitr jineho cyklu /Reset/Nacti}
u:=svazak^.first;
while u<>nil do
   begin
   v:=u^.vazba;
   if v^.znak=i then Exit(Svazak_SmazZnak(u));
   u:=u^.dalsi;
   end;
Svazak_SmazZnak:=false;
end;


Function TFontObjekt.Svazak_SmazZnak(u:PUzel):boolean;
var v:PZnakTab;
begin
v:=u^.vazba;
Dispose(v);
svazak^.ZrusUzel(u);
Svazak_SmazZnak:=true;
end;


Procedure TFontObjekt.Svazak_VlozZnak(i:longint);
var v:PZnakTab;
begin
New(v);
v^.znak:=i;
v^.vbloku:=false;
svazak^.poloha:=svazak^.first; {procedura InsertSort nechce, aby to bylo nil}
svazak^.InsertSort(v);
end;


Function TFontObjekt.Svazak_je_znak(i:longint):boolean;
var z:PZnakTab;
begin
Svazak^.Reset;
while not Svazak^.Konec do
   begin
   z:=Svazak^.Nacti;
   if z^.znak=i then exit(true);
   end;
Svazak_je_znak:=false;
end;


Function TFontObjekt.ZaradZnak(i:longint):longint;
{Z kreslitka prenese znak do definice fontu}
var v:virtualwindow;
    w:Pword;
    a1,a2,b1,b2,a,b:longint;
begin
Kreslitko.DejOhraniceni(a1,b1,a2,b2);
Init_VW(v,a2-a1+1,b2-b1+1,true);
w:=pointer(v.VWoffset);
for b:=b1 to b2 do
    for a:=a1 to a2 do
        begin
        if kreslitko.DejBod(a,b)<>0 then w^:=COMP_DECOMP;
        inc(w);
        end;
if fnf^.znak^[i].data<>nil
   then SmazZnak(i);   {jestli uz dany znak definovany je, tak ho smaz}

inc(fnf^.poc_znaku);
SpakujZnak(v,i,true);
Kill_VW(v);
kreslitko.znak:=i;
kreslitko.Zobraz;
Svazak_VlozZnak(i);
MouseRel;
ZaradZnak:=koOBNOV;
end;


Procedure TFontObjekt.Dealokuj_pamet_pro_znak(i:longint);
begin
if fnf^.znak^[i].data<>nil then FreeMem(fnf^.znak^[i].data,fnf^.znak^[i].dp);
fnf^.znak^[i].dp:=0;
fnf^.znak^[i].data:=nil;
end;


Procedure TFontObjekt.SmazZnak(i:longint;u:PUzel);
begin
Dealokuj_pamet_pro_znak(i);
dec(fnf^.poc_znaku);
if u=nil then Svazak_SmazZnak(i)  {a jeste ho smazeme ve svazaku}
         else Svazak_SmazZnak(u);
end;


Procedure TFontObjekt.SmazZnak(i:longint);
begin
SmazZnak(i,nil);
end;


Procedure TFontObjekt.SmazVse;
begin
if fnf<>nil then Znic_FN(fnf);            {zlikviduje surova data fontu}
fnf:=nil;
Vaznik_Done_All(svazak,@ZnicZnakTab);     {zlikviduje aplikacni nadstavbu}
end;


{****************************************************************************}
Procedure TFontObjekt.Analyzuj_BMP_Bunku(var v:virtualwindow);
var p1,p2:PByte;
    n:PWord;
    i:longint;
begin
inc(pocitadlo);
p1:=pointer(v.vwoffset);
p2:=pointer(prazdna_bunka.vwoffset);
if (v.size<>prazdna_bunka.size) or (CompareByte(p1^,p2^,v.size)<>0) then
   begin   {neni to prazdny znak}
   n:=pointer(v.vwoffset);
   for i:=1 to v.size div 2 do
       begin
       if n^=FIALOVA then n^:=0 else n^:=1;
       inc(n);
       end;
   SpakujZnak(v,cznaku,true);
   inc(fnf^.poc_znaku);
   Svazak_VlozZnak(cznaku);
   end;
end;


Procedure TFontObjekt.Extrahuj_BMP_Bunky(var v2:virtualwindow;pf:longint);
var n,x,x2,sirka,vyska,y:longint;
    w:word;
    nv:VirtualWindow;
begin
x:=1;
{$IFDEF DEBUG}
if dbgg=2000 then
   dbgg:=dbgg;
{$ENDIF}
for n:=1 to 16 do
    begin
    x2:=x;
    w:=GetPixel(v2,x,0);
    if (GetPixel(v2,x,0)=ZLUTA) or (GetPixel(v2,x,1)=ZLUTA) then
      begin  {jestlize bunka neni, kde by mela byt. Divne, ale obcas to byva...}
      inc(pocitadlo);
      sirka:=2;
      end
      else begin
         repeat
         inc(x2);
         until GetPixel(v2,x2,0)=ZLUTA;
      sirka:=x2-x;
      vyska:=pf;
      Init_VW(nv,sirka,vyska,false);
      GetSprite(v2,nv,x,0);
      Analyzuj_BMP_Bunku(nv);
      Kill_VW(nv);
      end;
    inc(cznaku);
    x:=x+sirka;
    if n<16 then
       repeat
       inc(x);
       until GetPixel(v2,x,0)<>ZLUTA;
    end;
inc(cznaku,1);
end;


Procedure TFontObjekt.VyjmiZnak_BMP_FFFF(var v2:virtualwindow;pf:longint);
var x,x2:longint;
begin
x:=v2.breiteminus1;
   repeat
   dec(x);
   until GetPixel(v2,x,0)<>ZLUTA;
x2:=x;
   repeat
   dec(x2);
   until GetPixel(v2,x2,0)=ZLUTA;
Init_VW(prazdna_bunka,x-x2,pf,false);
GetSprite(v2,prazdna_bunka,x2+1,0);
end;


Function TFontObjekt.Importuj_BMP(s:string):boolean;
var v1,v2:virtualwindow;
    pal:pBGRApalette;
    header:BMP_Header;
    buf:pointer;
    p,precteno:longint;
    h:PStream;
    poprve:boolean;
    hpoz:longint;
    pz:longint;
    pf:longint;
begin
pocitadlo:=0;
poc2:=0;
pz:=-1;
pf:=-1;
poprve:=true;
cznaku:=32767{65535}-16+1;
p:=LoadBMPheader(s,pal,header,h);
if p<>0 then
   begin
   Dispose(h,Done);
   Exit(false);
   end;
MouseSetCursor(UKmysCekej);

SmazVse;         {Kompletne zlikviduje nacteny font}
NewFont;         {Zalozi novy (zatim s defaultnimi hodnotami)}


fnt:=Convert_UP(StripName(s))+'.UFN';
Init_VW(v1,header.width*2,1,false);
p:=header.width*header.bits_per_pixel div 8+header.xres;
GetMem(buf,p);
hpoz:=h^.GetPos;

repeat
inc(pz);
LoadBMPlines(h,pal,buf,header,v1,precteno);
if poprve then
   begin
   poprve:=false;
   if GetPixel(v1,0,0)<>ZLUTA then
      begin
      MouseSetCursor(UKmys);
      Dispose(h,Done);
      Exit(false);
      end;
   end;
until GetPixel(v1,1,0)<>ZLUTA;
inc(pz);                           {v PZ je rozestup mezi bunkami}
poprve:=true;
repeat
inc(pf);
LoadBMPlines(h,pal,buf,header,v1,precteno);
until GetPixel(v1,1,0)=ZLUTA;      {v PF je vyska bunky}
h^.seek(hpoz);                     {znovu se nastavim na spodek bunky}
Kill_VW(v1);


fnf^.so:=pf;
fnf^.maxnad:=-pf;
fnf^.su:=0;
fnf^.maxpod:=0;
Init_VW(v2,header.width,pz+pf,false);
{totext;setcolors(7,0);clrscr;}
repeat
precteno:=0;
LoadBMPlines(h,pal,buf,header,v2,precteno);
if precteno=v2.hoehe then
   begin
   inc(poc2);
   dbgg:=poc2;
   if poprve then begin poprve:=false;VyjmiZnak_BMP_FFFF(v2,pf);end;
   Extrahuj_BMP_Bunky(v2,pf);
   dec(cznaku,2*16+1);
   end;
until precteno<>v2.hoehe;
Dispose(h,Done);
kreslitko.Ohraniceni;
kreslitko.Zobraz;
MouseSetCursor(UKmys);
Importuj_BMP:=true;
end;


Procedure TFontObjekt.Importuj_z_BMP;
var s:string;
begin
s:=VyberSouborOkno('Choose a BMP image',exedir+'*.*','BMP',350,0);
if s='' then Exit;
okokno(s,s);
if not FontObjekt^.Importuj_BMP(s) then
   OKokno('Error','Selected file isn''t in supported format');
end;


Function Ukaz_seznam_unicode_tbl_filtru:longint;
var s:string;
begin

end;


Procedure TFontObjekt.NatahniGlobalniDataFontu(f:PFont);
begin
fnf^.so:=f^.so;
fnf^.su:=f^.su;
fnf^.add:=f^.add;
fnf^.maxpred:=f^.maxpred;
fnf^.maxza:=f^.maxza;
fnf^.maxnad:=f^.maxnad;
fnf^.maxpod:=f^.maxpod;
end;


Procedure TFontObjekt.Import_z_256z_PFont(f:PFont);
var i,s,v:longint;
    b:byte;
    ov:boolean;
    t:string;
begin
ov:=false;

t:=Vyber_TBL_soubor_okno(ov);
if t='' then Exit;

FontObjekty[5].NatahniGlobalniDataFontu(f);

for i:=f^.first to f^.last do
    if f^.znak^[i].data<>nil then
       begin
       s:=f^.znak^[i].sirka;
       v:=f^.znak^[i].vyska;
       FontObjekty[5].PripravNedefinovanyZnak(i,s,v);
       Move(f^.znak^[i].data^,
            FontObjekty[5].fnf^.znak^[i].data^,
            FontObjekty[5].fnf^.znak^[i].dp);
       inc(FontObjekty[5].fnf^.poc_znaku);
       FontObjekty[5].Svazak_VlozZnak(i);
       end;

if t<>'[nic]' then
   begin
   b:=FontObjekt_num;
   Nacti_TBL_Prevodnik(t);
   FontObjekty[5].Zkopiruj_Rozmery_a_ukazatele(b,1);
   NatahniGlobalniDataFontu(FontObjekty[5].fnf);
   FontObjekty[5].Smaz_font_ale_ne_bitmapy(false);
   end
   else
   begin
   fnf:=FontObjekty[5].fnf;
   svazak:=FontObjekty[5].svazak;
   FontObjekty[5].fnf:=nil;
   FontObjekty[5].svazak:=nil;
   FontObjekty[5].NewFont;
   end;
end;


Function ASCII_2_Uni(w:word):longint;
begin
if (w>127) and (w<256) then ASCII_2_Uni:=TBL_Prevodnik[w]
                       else ASCII_2_Uni:=w;
end;


Function Uni_2_ASCII(w:word):longint;
var b:longint;
begin
if w<128 then Uni_2_ASCII:=w else
   begin
   for b:=128 to 255 do
       if TBL_Prevodnik[b]=w then Exit(b);
   Uni_2_ASCII:=w;
   end;
end;


Procedure TFontObjekt.Smaz_Font_ale_ne_bitmapy(ne_svazak:boolean);
{Predpoklada, ze odkazy na bitmapy jsou zalohovane jinde}
var z:PZnakTab;
    P:PVaznik;

begin
Svazak^.Reset;
while not Svazak^.Konec do
   begin
   z:=Svazak^.Nacti;
   fnf^.znak^[z^.znak].data:=nil;   {odpojime ukazatel, aby se nesmazal i buffer samotny}
   end;

if ne_svazak then begin p:=svazak;svazak:=nil;end;
SmazVse;
NewFont;
if ne_svazak then svazak:=p;
end;


Procedure TFontObjekt.Zkopiruj_Rozmery_a_ukazatele(kam:byte;smer:byte);
{To znamena, ze kopiruje vsechno krome bitmap
 KAM = cislo v poli FontObjekty[]
 SMER = [0,1,2]: 0 = bez konverze, 1 = ASCII->uni, 2 = uni->ASCII
}
var z:PZnakTab;
    i,j:longint;
begin
Svazak^.Reset;
while not Svazak^.Konec do
   begin
   z:=Svazak^.Nacti;
   i:=z^.znak;
   if smer=0 then j:=i else
   if smer=1 then j:=ascii_2_uni(i) else
   if smer=2 then j:=uni_2_ascii(i);

   if (smer in [0,2]) or (not FontObjekty[kam].Svazak_je_znak(j))
      then begin
      FontObjekty[kam].Svazak_VlozZnak(j);
      move(fnf^.znak^[i],
           FontObjekty[kam].fnf^.znak^[j],
           sizeof(fnf^.znak^[i]));
      inc(FontObjekty[kam].fnf^.poc_znaku);
      end;
   end;

if smer=2 then
   begin
   i:=-1;
   FontObjekty[kam].Svazak^.Reset;
   while not FontObjekty[kam].Svazak^.Konec do
      begin
      z:=FontObjekty[kam].Svazak^.Nacti;
      if z^.znak=i then {duplicita}
         FontObjekty[kam].Svazak^.ZrusUzel(FontObjekty[kam].Svazak^.nacteny);
      i:=z^.znak;
      end;
   end;

end;


Procedure TFontObjekt.Prekoduj_z_ASCII_do_UNI(t:string;smer:byte;pr:boolean);
{Predpoklada, ze FontObjekty[5] je uz naplnen fontem a my jsme prazdni}
var b:byte;
    h:PFont;
    o:PVaznik;
    z,z2:PZnakTab;
    i:longint;
    q1,q2:pointer;
    p,nalezeno:boolean;

begin
Nacti_TBL_Prevodnik(t);

FontObjekty[5].NatahniGlobalniDataFontu(fnf);

i:=FontObjekty[5].Svazak^.PocetUzlu;
Zkopiruj_Rozmery_a_ukazatele(6,0); {stavajici stav ulozime}
Zkopiruj_Rozmery_a_ukazatele(5,smer); {a posleze zkonvertujeme}

i:=FontObjekty[5].Svazak^.PocetUzlu;

{a ted jde o to, jak to zkombinovat zkonvertovane s puvodnim}

Smaz_Font_ale_ne_bitmapy(false);   {necham bitmapy, ostatni smazu}
FontObjekty[5].Svazak^.Reset;
while not FontObjekty[5].Svazak^.Konec do
   begin
   B:=5;
   z:=FontObjekty[5].Svazak^.Nacti;
   i:=z^.znak;

   if FontObjekty[6].DefZnak(i) then
      if pr=true then
         B:=5
         else B:=6;

   move(FontObjekty[B].fnf^.znak^[i],
        fnf^.znak^[i],
        sizeof(fnf^.znak^[i]));


   Svazak_VlozZnak(i);
   end;

fnf^.poc_znaku:=FontObjekty[5].fnf^.poc_znaku;


{Ted je treba zkontrolovat, jestli nekde nezustaly bitmapy, na nez se uz
 neodkazuje}

FontObjekty[6].Svazak^.Reset;
while not FontObjekty[6].Svazak^.Konec do
   begin
   z:=FontObjekty[6].Svazak^.Nacti;
   q1:=FontObjekty[6].fnf^.znak^[z^.znak].data;

   nalezeno:=false;
   Svazak^.Reset;
   while not Svazak^.Konec do
      begin
      z2:=Svazak^.Nacti;
      q2:=fnf^.znak^[z2^.znak].data;
      if q1=q2 then begin nalezeno:=true;Break;end;
      end;
   if not nalezeno then FreeMem(q1);
   end;

NatahniGlobalniDataFontu(FontObjekty[5].fnf);

FontObjekty[5].Smaz_Font_ale_ne_bitmapy(false);
FontObjekty[6].Smaz_Font_ale_ne_bitmapy(false);
end;



Procedure TFontObjekt.Importuj_z_VGAD;
var ok:Tokno_s_tlacitky;
    p:PPrepinace;
    i:byte;
    s:string;
    f:PFont;
begin
ok.Init(NA_STRED,NA_STRED,250,110,'Which hardware font to use?',w_OK+#9+w_CANCEL);
p:=New(PPrepinace,Init(ok.x+5,ok.y+30,'8 pixel height'+#13#10+
                                      '14 pixel height'+#13#10+
                                      '16 pixel height',1,0));
ok.Pridej(p);
ok.Zobraz;
ok.Run;

if ok.hodnota<>ww_zrus then
   begin
   i:=p^.VratByte;
   case i of
   1:s:=FN_FONT_VGA8;
   2:s:=FN_FONT_VGA14;
   3:s:=FN_FONT_VGA16_U;
   end; {case}
   SmazVse;         {Kompletne zlikviduje nacteny font}
   NewFont;         {Zalozi novy (zatim s defaultnimi hodnotami)}
   VGAfont_2_PFont(s,f,false); {FALSE: neprevadej 8-bitove znaky na 9-bitove}
   Import_z_256z_PFont(f);
   Znic_FN(f);
   Kreslitko.Ohraniceni;
   Kreslitko.Zobraz;
   end;
ok.Done;
end;


Procedure TFontObjekt.Proved_Export_do_VGAF(s:string);
{Velmi prisne vyzaduje, aby sirka vsech znaku byla 8 pixelu, tzn. co radka
 znaku, to jeden bajt.}
var f:file;
    prazdny_znak:array[0..32] of byte;
    a,b:longint;

begin
Assign(f,s);
Rewrite(f,1);
FillChar(prazdny_znak,vfh,0);  {pripravi prazdny blok pro pripadne nedefinovane znaky}

{Pred exportem musim vsechny znaky prevest na 8-znakovou sirku. To je ale
 nevratny krok, a proto napred udelam kopii fontu do neviditelny 5-te sady
 a konverzi provedu z ni.}

b:=FontObjekt_Num;
FontObjekty[5].fnf^.so:=fnf^.so;
FontObjekty[5].fnf^.su:=fnf^.su;
Proved_Transfer_Znaku(b,5,true);

for a:=0 to 255 do
    if FontObjekty[5].fnf^.znak^[a].data=nil
          then BlockWrite(f,prazdny_znak,vfh)
          else begin
          if FontObjekty[5].fnf^.znak^[a].sirka<>8 then
             FontObjekty[5].NastavSirkuZnaku(a,8);
          BlockWrite(f,FontObjekty[5].fnf^.znak^[a].data^,vfh);
          end;
Close(f);
FontObjekty[5].SmazVse;
FontObjekty[5].NewFont;
end;


Function TFontObjekt.ZKontroluj_8px_sirku:boolean;
var p:PZnakTab;
begin
Svazak^.Reset;
while not Svazak^.Konec do
   begin
   p:=Svazak^.Nacti;
   if fnf^.znak^[p^.znak].sirka<>8 then Exit(false);
   end;
ZKontroluj_8px_sirku:=true;
end;


Procedure TFontObjekt.Exportuj_do_VGAF;
var m,s:string;
    b:boolean;
begin
if fnt='' then m:='newfont.ch' else m:=StripName(fnt)+'.ch';
s:=UlozSouborOkno('Enter filename',GetFontAdr+m,300,false);
if s<>'' then
   begin
   if not (vfh in [8,14,16])
      then b:=AnoNeOkno('?','Nonstandard font height'+#13#10+
                            '(other than 8,14,16px)'+#13#10+
                            'Continue anyway?')
      else b:=true;
   if B then
      begin
      b:=ZKontroluj_8px_sirku;
      if b=false then b:=AnoNeOkno('?','Some chars aren''t 8px wide'+#13#10+
                                       'Shall I adjust them and continue?');
      if B then Proved_Export_do_VGAF(GetFontAdr+s);
      end;
   end;
end;


Procedure TFontObjekt.Importuj_z_VGAF;
var s:string;
    f:PFont;
    ff:file;
    l:longint;
begin
s:=VyberSouborOkno('Choose a VGA font file',exedir+'*.*','',350,0);
if s<>'' then
  begin
  FN_error:=FN_OK;
  Assign(ff,s);  Reset(ff,1);  l:=FileSize(ff);  Close(ff);
  if ((l mod 8)<>0) or (l<256*6) or (l>256*32)
     then OKokno('!','It is not a VGA font file!')
     else begin
     VGAfont_2_PFont(s,f,false); {FALSE: neprevadej 8-bitove znaky na 9-bitove}
     if FN_error=FN_OK then
        begin
        SmazVse;         {Kompletne zlikviduje nacteny font}
        NewFont;         {Zalozi novy (zatim s defaultnimi hodnotami)}
        Import_z_256z_PFont(f);
        Znic_FN(f);
        Kreslitko.Ohraniceni;
        Kreslitko.Zobraz;
        end;
     end;
  end;
end;



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


Procedure TFontObjekt.Zlikviduj_bitmapu;
begin
Dispose(vw,Done);   {zmazu zobrazovaci objekt}
Kill_VW(pro_vw);    {i zobrazovanou bitmapu samotnou}
{svazak necham na pokoji, protoze mozna neni nutne, aby byl cely smazan}
end;


Destructor TFontObjekt.Done;
begin
SmazVse;
end;


Procedure HlavniSmyckaProgramu;
var i,j:longint;
    konec:boolean;

begin
konec:=false;

repeat  {vnejsi cyklus - do nej se z proc. MapaZnaku dostaneme, pokud se
         zmeni nejaky znak ve FontObjekt a bude treba nejaky update}

FontObjekt^.Priprav_na_zobrazeni;
FontObjekt^.vw^.zobraz;

i:=MapaZnaku;   {drobnejsi udalosti zustanou poresene uvnitr proc. MapaZnaku}
FontObjekt^.Zlikviduj_bitmapu;
     {...slo by optimalizovat, ze by se smazala jen nekdy...}

case i of
  koNOVY:NovyProjekt;
  koFILES_LOAD:FontObjekt^.NactiFont('');
  koFILES_SAVE:FontObjekt^.UlozFont;
  koFILES_IBMP:FontObjekt^.Importuj_z_BMP;
  koFILES_IVGAD:FontObjekt^.Importuj_z_VGAD;
  koFILES_IVGAF:FontObjekt^.Importuj_z_VGAF;
  koFILES_EVGAF:FontObjekt^.Exportuj_do_VGAF;
  koKONEC:i:=PotvrdKonec;
  else
  if i>koZMENA_FONT_OBJ_PREFIX then
     begin
     {okokno('yyy','tttt');}
     j:=i-koZMENA_FONT_OBJ_PREFIX;
     FontObjekt:=@FontObjekty[j];
     Kreslitko.Ohraniceni;
     Kreslitko.Zobraz;
     end;
  end; {case}



until i=koJISTYKONEC;
end;


{===========================================================================}
{===========================================================================}

var i:longint;
    konec:boolean;
    deb:string;

begin
FontObjekt:=New(PFontObjekt,Init);
FN_color:=0;
OldExitProc:=ExitProc;
ExitProc:=@MyExitProc;

NactiHlasky_ze_souboru('kasmar.en'); {wokna32}

Init_Graph(find_mode(obv_sta_x,obv_sta_y),LFB_ACCESS,BEST_FQ or 70);

FontAdr(EXEdir+'fonty\');              {Adresar s fonty}
FN_PCX_adresar:=EXEdir;

Init_Mouse(vga);
MouseSpeed(4,4);
MouseShow;

{}global_debug_count:=-1;

NastavAktualniFont('latin216.ch');
Nacti_FN('cour10.fn',mmm);
prostor_pro_text_FFFFh_v_mmm_fontu:=Sirka_FN('FFFFh',mmm);
Clr(vga,11648);



PripravObjekty;
NovyProjekt;
if ParamCount=1 then FontObjekt^.NactiFont(ParamStr(1));

Init_VW(schovane_pozadi,SIRKA_MAPY_ZNAKU,VYSKA_MAPY_ZNAKU,false);
MouseHide;
GetSprite(vga,schovane_pozadi,POLOHA_MAPY_ZNAKU_X,POLOHA_MAPY_ZNAKU_Y);
MouseShow;     {pozadi snad staci schovat jenom jednou zde a pak uz nemenit}

HlavniSmyckaProgramu;


Kill_VW(schovane_pozadi);
ObvyklyKonec;
end.
