{Cast zdrojoveho kodu pro program Blocek}

unit BloMapZn;
{$INCLUDE defines.inc}

interface
const
BARVA_FIALOVA=63519;

Function MapaZnaku(xf:pointer {ve skutecnosti PFont}):longint;

implementation
uses VenomGFX,Fnfont2,Vaznik,Lacrt,wokna32,Rezklav;

const
BARVA_MP_ZNAKU_BUNKA_NORM_POP = 65535;
BARVA_MP_ZNAKU_BUNKA_NORM_POP2 = 330;
BARVA_MP_ZNAKU_BUNKA_NORM_POZ = {1234;}1756;
BARVA_MP_ZNAKU_BUNKA_NEDEF = {742;}38935;
BARVA_MP_ZNAKU_BUNKA_STI_POP = 655;
BARVA_MP_ZNAKU_BUNKA_STI_POP2 = 25356;
BARVA_MP_ZNAKU_BUNKA_STI_POZ = 7;

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


Procedure DataUnicodeTabulky(g:pfont;i,j:longint;p:Pvaznik;var a,b:longint);
var n,k,e,f:longint;
    v:PZnakTab;
begin
n:=-1;
k:=0;
e:=0;
f:=0;
repeat
inc(n);
if g^.znak^[n].data<>nil then
   begin
   inc(k);
   New(v);
   v^.znak:=n;
   v^.x1:=e;
   v^.y1:=f;
   v^.x2:=e+i;
   v^.y2:=f+j;
   inc(e,i);
   if k mod 16=0 then
      begin
      a:=v^.x2+1;
      e:=0;
      inc(f,j);
      end;
   p^.InitNext(v);
   end;
until k=g^.poc_znaku;
b:=v^.y2+1;
end;

Procedure DataASCIItabulky(i,j:longint;p:PVaznik;var a,b:longint);
var v:PZnakTab;
    c,d,e,f:longint;
begin
a:=i*16+1;
b:=j*16+1;
f:=0;
for d:=0 to 15 do
    begin
    e:=0;
    for c:=0 to 15 do
        begin
        New(v);
        v^.znak:=d*16+c;
        v^.x1:=e;
        v^.y1:=f;
        v^.x2:=e+i;
        v^.y2:=f+j;
        e:=v^.x2;
        p^.InitNext(v);
        end;
    f:=v^.y2;
    end;
end;


Function Urci_znak_v_tabulce(p:PVaznik;mx,my:longint):PZnakTab;
var q:PUzel;
    v:PZnakTab;
begin
q:=p^.first;
while q<>nil do
   begin
   v:=q^.vazba;
   if Uvnitr(mx,my,v^.x1,v^.y1,v^.x2,v^.y2) then Exit(v);
   q:=q^.dalsi;
   end;
Exit(nil);
end;

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


Procedure NakresliBunku(n:PZnakTab;pop,pop2,poz:word;f,m:pfont;v:virtualwindow);
var e:word;
    s:string;
    aa,i:longint;
begin
{FN_ignore:=false;}
NastavVystup(@v);
e:=n^.znak;
Rectangle(v,n^.x1,n^.y1,n^.x2,n^.y2,65535);
i:=(n^.x1+n^.x2) div 2;
if f^.znak^[e].data=nil then Bar(v,n^.x1+1,n^.y1+1,n^.x2-1,n^.y2-1,BARVA_MP_ZNAKU_BUNKA_NEDEF)
   else begin
   Bar(v,n^.x1+1,n^.y1+1,n^.x2-1,n^.y2-1,poz);
   FN_color:=pop;
   Print_Char(i-(f^.znak^[e].sirka div 2),n^.y1+f^.so+2,e,f,pop);
   end;
FN_color:=pop2;
s:=Mystr(e);
aa:=Sirka_FN(s,m) div 2;
Print_FN(i-aa,n^.y2-m^.so,s,m);
s:=Dec2Hex(e)+'h';
aa:=Sirka_FN(s,m) div 2;
Print_FN(i-aa,n^.y2-1,s,m);
NastavVystup(@vga);
{FN_ignore:=true;}
end;



Procedure VykresliBunky(p:PVaznik;f,m:pfont;v:virtualwindow);
var q:PUzel;
    e:PZnakTab;
begin
q:=p^.first;
while q<>nil do
   begin
   e:=q^.vazba;
   NakresliBunku(e,BARVA_MP_ZNAKU_BUNKA_NORM_POP,
                   BARVA_MP_ZNAKU_BUNKA_NORM_POP2,
                   BARVA_MP_ZNAKU_BUNKA_NORM_POZ,f,m,v);
   q:=q^.dalsi;
   end;
end;


Function MapaZnaku(xf:pointer):longint;
var f,mmm:pfont;
    a,b,i,j,kod:longint;
    sx,sy,sb,mx,my,mb,mxx,myy:longint;
    ks:string;
    hv:boolean;
    p:Pvaznik;
    v,zal:virtualwindow;
    vz,ovz:PZnakTab;
    vw:PVyrez;

begin
f:=xf;

Nacti_FN('cour10.fn',mmm);
a:=Sirka_FN('FFFFh',mmm);


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

if f^.unicode then DataUnicodeTabulky(f,i,j,p,a,b)
              else DataASCIItabulky(i,j,p,a,b);
Init_VW(v,a,b,false);
Clr(v,742);
VykresliBunky(p,f,mmm,v);
a:=v.breite+Sirka_pos;
if v.hoehe>460 then b:=460 else b:=v.hoehe;
vw:=New(PVyrez,Init(ZeStreduX(NA_STRED,a),ZeStreduY(NA_STRED,b),a,b,@v,0));
{vw^.kresli_ramecek:=false;}
Init_VW(zal,a+1,b+1,false);
MouseHide;
GetSprite(vga,zal,vw^.x,vw^.y);
MouseShow;
vw^.zobraz;

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

PustKlavesu;

repeat
HlidejKlavesy;
vw^.kontrola;
if xKlavesa.ASCII=xESC then
   begin
   vz:=nil;
   Break;
   end;
mx:=mouse.x;
my:=mouse.y;
mb:=mouse.b;
{if (mx<>sx) or (my<>sy) then}
if vw^.Mys_se_pohla then
   begin
   if vw^.Mys_uvnitr then  {muze byt vylozene uvnitr nebo na posuvnicich}
      begin
      if vw^.Bod_uvnitr_vnitrni_casti(vw^.mys_xx,vw^.mys_yy)
         then begin
         mxx:=vw^.mys_xx-vw^.x+vw^.poc_ZobrX;
         myy:=vw^.mys_yy-vw^.y+vw^.poc_ZobrY;
         vz:=Urci_znak_v_tabulce(p,mxx,myy);
         if (vz<>nil) and (vz<>ovz) then   {VZ by NIL nemelo byt nikdy}
            begin
            if ovz<>nil then NakresliBunku(ovz,BARVA_MP_ZNAKU_BUNKA_NORM_POP,
                                               BARVA_MP_ZNAKU_BUNKA_NORM_POP2,
                                               BARVA_MP_ZNAKU_BUNKA_NORM_POZ,
                                               f,mmm,v);
            NakresliBunku(vz,BARVA_MP_ZNAKU_BUNKA_STI_POP,
                             BARVA_MP_ZNAKU_BUNKA_STI_POP2,
                             BARVA_MP_ZNAKU_BUNKA_STI_POZ,
                             f,mmm,v);
            vw^.Zobraz;
            ovz:=vz;
            end;
         end else vz:=nil;
      end;
   end;

if mb=1 then
   begin
   if vw^.je_posunovano=false then
      begin
      if vw^.Bod_uvnitr_vnitrni_casti(vw^.mys_xx,vw^.mys_yy)=false then a:=-1;
      kod:=1;
      end;
   end;

if mb=2 then kod:=2;

until kod<>0;

MouseRel;
if (kod=1) and (vz<>nil)
   then a:=vz^.znak
   else a:=-1;

MouseHide;
PutSprite(vga,zal,vw^.x,vw^.y);
MouseShow;
Kill_VW(zal);
Dispose(vw,Done);
Vaznik_Done_All(p,@ZnicZnakTab);
Kill_VW(v);
Znic_FN(mmm);
MapaZnaku:=a;
end;

end.
