unit Fonty;
{Jednotka zajistujici vystup textu v grafickych rezimech pri pouziti unitu
 VenomGFX.}

interface

const
   font_unknown = 0;
   font_fn      = 1;
   font_vga     = 2;
   font_ufn     = 3;
   font_ttf     = 4;
   font_chr     = 5;

   font_flags_unicode = 1;
   font_flags_vector  = 2;

   font_vga8  = 'VGA:8';   {Pozn. stazeni fontu z VGA generatoru do pameti}
   font_vga14 = 'VGA:14';  {ma na starosti jednotka VenomGFX}
   font_vga16 = 'VGA:16';

   font_ok           = 0;
   font_err_notready = 1;
   font_err_nofile   = 1;
   font_err_unknown  = 2;


   FN_global_barva:word = 65535;  {defaultni vychozi barva}


type
THeapArray4 = array[1..maxlongint div 4] of pointer;

PFNZasobnik = ^TFNzasobnik;
TFNZasobnik = object
  pole:^THeapArray4;
  baze,num,max:longint;
  kruh:boolean;
  err:byte;
  Constructor Init(imax:longint;ikruh:boolean);
  Procedure Dej(p:pointer);    {Umisti do zasobniku atribut}
  Function Vem:pointer;        {Sejme ze zasobniku atribut}
  Function Cti:pointer;        {Ukaze na vrchol zasobniku, ale nesejme z nej}
  Function CtiN(a:longint):pointer; {Ukaze ne na posledni, ale na N-ty prvek}
  Destructor Done;
end;




PFatrb = ^TFatrb;
TFatrb = record
  rez:string[30];         {nazev fontu}
  barva:longint;           {barva}
  pozadi:longint;          {pozadi}
  velikost:byte;           {velikost (ma vyznam jenom u vektorovych fontu)}
                           {POZOR, nemusi jit o vysku v pixelech}
  flags:byte;              {priznaky - viz konstanty FATRB_...}
  end;

const
  fatrb_podtrh = 1;        {podtrzeni textu}
  fatrb_select = 2;        {efekt urceny pro text zadany do bloku}
  fatrb_prop   = 4;        {prinuti psat vsechna pismena stejne siroka}

  fcode_ascii = 0;
  fcode_utf8  = 1;
  fcode_utf16 = 2;

type

PFontJob = ^TFontJob;
TFontJob = object
  cil:pointer;          {kam se bude psat - musi to byt PVirtualWindow}
  atrbzas:TFNZasobnik; {zasobnik s popisem atributu ve formatu}
  fromline:boolean;                 {jestli se pise od vrsku nebo od linky}
  coding:byte;       {v jakem kodovani je vstupni text (ASCII, UTF-8,...)}
  ox,oy,x,y:longint;
  ox1,oy1,ox2,oy2:longint;          {vystupni okno}
  Constructor Init;
  Procedure ZalozZasobnik;
  Procedure NactiAktZasobnik;
  Procedure NastavCil(p:pointer);   {P musi byt PVirtualWindow}
  Procedure NastavPozici(ix,iy:longint);

  Function FontVyska:longint;  {vyska radky}
  Function FontSO:longint;
  Function FontSU:longint;
  Function TextVyska(p:pchar):longint;
  {vyska vypsaneho textu. Pokud je viceradkovy, je jiny nez FontVyska}
  Function TextVyska(s:string):longint;
  Function TextSirka(p:pchar):longint;
  Function TextSirka(s:string):longint;

  Procedure NastavAtrb(s:string);
  {Nastavi atributy pomoci specifikacniho retezce. Format je:}
  {R:rez B:barva V:velikost P:pozadi F:flags}
  {nemusi byt specifikovane vsechny polozky - ty neurcene se zkopiruji z
   drivejsiho zaznamu zasobniku}

  Function VratAtrb:string;

  {Tato sada procedur a funkci ovlivnuje aktualni atribut - na zasobnik
   nic nepridava ani z neho neodebira}
  Procedure NastavBarvu(b:longint);
  Function VratBarvu:longint;
  Procedure NastavRez(s:string);
  Function VratRez:string;
  Procedure NastavVelikost(b:byte);
  Function VratVelikost:byte;
  Procedure NastavPozadi(b:longint);
  Function VratPozadi:longint;
  Procedure NastavFlagy(b:byte);
  Function VratFlagy:byte;

  {--------------------------------------------------------------------}

  Procedure Print(s:string);
  Procedure Print(p:pchar);
  Function CtiZnak(p:pchar;var a:longint):word;
  Function PripravFont(h:PFatrb;w:word):pointer;   {PFont}

  Procedure UlozNaZasobnik(a:TFAtrb);
  Destructor Done;
end;

{============================================================================}
{============================================================================}
implementation
uses Go32,Dos,GrpFile,VenomGFX;

{type}


const mngr_max = 50;   {soucasne bude v pameti 50 rezu}
      bitmap_vel = 12; {ne-vektorove fonty se budou povazovat za tuto vel.}
      FN_zas_max = 50; {hloubka zasobniku}

      fnmagic = 'ëmÕonç ';
      ufnmagic = 'öaö'#0;

type
pstring = ^string;


PZnak = ^TZnak;
TZnak = object
  relx:shortint;
  rely:shortint;
  sirka:word;
  vyska:word;
  shift:shortint;
  dp:word;
  data:pbyte;
  {------------------}
  Procedure Init;
  Procedure Komprimuj;            {normalni stav}
  Procedure Dekomprimuj;          {dekomprimovany muze byt jen prechodne}
  Procedure Udelej_Proporcni;     {vyrobi z neproporcniho znaku proporcni}
end;


PFontFormat = ^TFontFormat;
TFontFormat = object
{jde o abstraktni objekt, bude predefinovat potomky}
  rez:string[30];
  typ:byte;                      {zda FN, TTF, VGA,...}
  flags:byte;                    {viz konstanty FONT_FLAGS_...}
  nazev:pstring;                 {vnitrni jmeno (je-li definovano)}

  __znak:PZnak;  {Muze byt loadery pouzit jako docasne misto kam bude}
                 {rozepsan znak, ktery pak bude presmerovan na TFONT.ZNAK}
  error:byte;         {podle potreby se bude plnit kodem chyby}
  {}
  vel,so,su,add:word;
  {vyska radky v pixelech, space over, space under, pevna cast mezery mezi znaky}
  maxsirka:word;      {bude se pouzivat pro neproporcionalni psani}
  {pro ruzne efekty, kdy casti pismen precuhuji mimo vyhrazene misto}
  {}
  {}{}{}{}{}{}
  Constructor Init(s:string);                   {inicializace, ale ne nacteni}
  Procedure Load;virtual;abstract;              {nacte font}
  Function PripravZnak(w:word):PZnak;virtual;abstract; {pripravi strukturu Znak}
  {nebude mit vlastni alokaci - vzdy bude jen ukazovat jinam}
  Destructor Done;virtual;                      {uklid}
end;


PFont_FN = ^TFont_FN;
TFont_FN = object(TFontFormat)
   first,last:byte;      {prvni definovany, posledni definovany}
   defznaku:array[0..255] of TZnak;
   Constructor Init(s:string);
   Procedure Load;virtual;
   Function PripravZnak(w:word):PZnak;virtual;
   Procedure SmazZnaky;
   Destructor Done;
end;


PFont_VGA = ^TFont_VGA;
TFont_VGA = object(TFontFormat)
   defznaku:array[0..255] of TZnak;
   Constructor Init(s:string);
   Procedure Load;virtual;
   Procedure LoadVRAM(vyska:byte);
   Function PripravZnak(w:word):PZnak;virtual;
   Procedure SmazZnaky;
   Destructor Done;
end;


PFont_UFN = ^TFont_UFN;
TFont_UFN = object(TFontFormat)
   Constructor Init(s:string);
   Procedure Load;virtual;
   Function PripravZnak(w:word):PZnak;virtual;
   Destructor Done;
end;


PFont_TTF = ^TFont_TTF;
TFont_TTF = object(TFontFormat)
   Constructor Init(s:string);
   Procedure Load;virtual;
   Function PripravZnak(w:word):PZnak;virtual;
   Destructor Done;
end;



PFont = ^TFont;
TFont = object
  {Napred tri veliciny, podle kterych bude dany font identifikovan v systemu}
  {}rez:string[30];                {nazev souboru odkud budeme tahat data}
  {}velikost:byte;         {velikost fontu, POZOR, nemusi byt v pixelech}
  {}cp:word;                       {ktera 256-znakova sada se pouzije}
                                   {(0=2..255; 1=256..511; 2=512..767);...}
  motor:PFontFormat;    {ve skutecnosti to bude nejaky potomek PFontFormat}

  _err:byte;
  status:byte;        {Vrati status posledni operace. Nejde o chybovy kod.}
  znak:PZnak; {Tato promenna je plnena pomoci fce PripravZnak, ktera zajisti}
              {aby ZNAK miril na stejne misto jako MOTOR^.ZNAK}

  cil:PVirtualWindow; {kam se pise - je ovladano z TFontJob}

  Constructor Init(s:string;ivelikost:byte;icp:word);
                              {zanalyzuje vstupni format a podle toho}
                              {inicializuje prislusny motor}


  Function Error:byte;        {zjisti, nastala-li chyba}
  Procedure PripravZnak(w:word);
  Function SirkaZnaku(atrb:PFAtrb):word;
  Procedure PisZnak(x,y:longint;w:word;atrb:PFAtrb);
  Destructor Done;
end;


PManager = ^TManager;
TManager = object
{vsechny rezy, ktere jsou pouzivany v programu jsou spravovany jedinym}
{objektem. Objekt je tohoto typu}
   zaso:array[1..mngr_max] of PFont; {zde jsou ulozene vsechny nactene fonty}


   _lastcp:longint;    {sada pomocnych promenych}
   _lastatrb:pointer;  {ktera bude urychlovat nacitani fontu}
   _lastfont:pointer;  {z pameti}
   zasonum:longint;

   Procedure Init;                         {inicializace}

   Procedure VycistiFonty;
   Function PripravFont(atrb:PFatrb;znak:word):PFont;
   {Zajisti pro TFontJob potrebny font - budto ho najde v zasobniku nebo ho}
   {nacte z disku (nebo sejme z VGA)}


   {----------------------------------------}
   Function ShodaFontu(a:longint;atrb:PFatrb;cp:word):boolean;
   Procedure Load; {nacte font z disku}
end;



var manager:TManager; {jednotny spravce vsech pouzitych fontu v programu}
    tempcharset:TVGACharset;
    {nasledujici tri promenne byly presunuty do jednotky VenomGFX}

    (*vga8charset:TVGACharset;   {trvale ulozeni VGA8 (nacte se pri initu)}
    vga14charset:TVGACharset;  {trvale ulozeni VGA14}
    vga16charset:TVGACharset;  {trvale ulozeni VGA16}*)
    {------------------------------------------------------------}



{==========================================================================}
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;


Function ZrusPstring(p:pstring):pointer;
var l:longint;
begin
if p<>nil then
   begin
   l:=Length(p^)+1;
   FreeMem(p,l);
   end;
ZrusPstring:=nil;
end;


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


Function MyStr (Cislo: longint): string;
var s:string;
begin
Str(Cislo,s);
MyStr:=s;
end;


Function MyVal(S:string):longint;
var Pom2 : Integer;
    pom1 : longint;
begin
Val(S,Pom1,Pom2);
MyVal:= Pom1;
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 DebugFNT(s:string);
begin
asm mov ax,3;int 10h;end;
writeln(s);
writeln('(zmackni neco)');
readln;
Halt;
end;


Constructor TFNZasobnik.Init(imax:longint;ikruh:boolean);
begin
num:=0;
baze:=1;
max:=imax;
kruh:=ikruh;
GetMem(pole,max*4);
end;


Procedure TFNZasobnik.Dej(p:pointer);
var i:longint;
begin
err:=0;
if num<max then
   begin
   inc(num);
   i:=baze+num-1;
   if i>max then i:=max-i;
   pole^[i]:=p;
   end
   else if kruh=false then err:=1
      else begin
      inc(baze);
      i:=baze-1;
      if baze>max then baze:=1;
      pole^[i]:=p;
      end;
end;


Function TFNZasobnik.Cti:pointer;
var i:longint;
    p:pointer;
begin
if num=0 then begin err:=1;Cti:=nil;Exit;end;
err:=0;

i:=baze-(max-num+1);

if i<1 then i:=max+i; {I je zaporne, takze nesmi nastat ze "-" a "-" je plus}

p:=pole^[i];

Cti:=p;
end;


Function TFNZasobnik.CtiN(a:longint):pointer;
begin
CtiN:=pole^[a];
end;


Function TFNZasobnik.Vem:pointer;
begin
Vem:=Cti;
if err=0 then dec(num);
end;


Destructor TFNZasobnik.Done;
begin
FreeMem(pole,max*4);
end;



Function CheckTTF_format(p:string):boolean;
{v retezci je 64 prvnich bajtu ev. TTF souboru (normalne od p[1])}
begin
CheckTTF_format:=false;  {jeste neumim nacist TTF}
end;


Function CheckVGA(l:longint):boolean;
{v L je velikost souboru. (ulozene VGA fonty nemaji hlavicku a daji se proto
 detekovat jenom podle velikosti)}
begin
if (l=2048) or (l=4096) or (l=3584) or (l=4864) then CheckVGA:=true else
   CheckVGA:=false;
end;



Constructor TFontFormat.Init(s:string);
begin
rez:=s;
nazev:=nil;                {jeste jsme nic nenacetli, tak nezname vnitrni jm.}
__znak:=nil;               {neni pripravena zadna definice znaku}
error:=font_ok;            {zatim nemohla nastat chyba}
flags:=0;
typ:=font_unknown;
end;


Destructor TFontFormat.Done;
begin
ZrusPstring(nazev);
end;


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


Procedure TZnak.Komprimuj;
{Zkomprimuje znak}
var a,b,c,d:longint;
    p,g,pp:pbyte;
    j:byte;
begin
if data=nil then Exit;
b:=sirka*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:=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(data);
dp:=c;
data:=p;
end;


Procedure TZnak.Dekomprimuj;
{Dekomprese znaku}
var a,c:longint;
    p,q:pbyte;
begin
if data=nil then Exit;
c:=sirka*vyska;
p:=data;
GetMem(data,c);
q:=data;
for a:=0 to dp-1 do
    begin
    Expand(p[a],q);
    inc(q,8);
    end;
dp:=c;
FreeMem(p);
end;


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


begin
vlevo:=0;
vpravo:=0;

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

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

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

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

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

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

dp:=vyska*sirka;
GetMem(data,dp);  {puvodni DATA jsou zkopirovane do P}

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

FreeMem(p,odp);
end;


Constructor TFont_FN.Init(s:string);
begin
inherited Init(s);
typ:=font_fn;
end;


Procedure TFont_FN.Load;
begin

end;


Function TFont_FN.PripravZnak(w:word):PZnak;
{naplni promennou Znak definici pozadovaneho znaku}
begin

end;


Procedure TFont_FN.SmazZnaky;
begin

end;


Destructor TFont_FN.Done;
begin
inherited Done;
end;


Constructor TFont_UFN.Init(s:string);
begin
inherited Init(s);
typ:=font_ufn;
flags:=font_flags_unicode;
end;


Procedure TFont_UFN.Load;
begin

end;


Function TFont_UFN.PripravZnak(w:word):PZnak;
{naplni promennou Znak definici pozadovaneho znaku}
begin

end;


Destructor TFont_UFN.Done;
begin
inherited Done;
end;


Constructor TFont_TTF.Init(s:string);
begin
inherited Init(s);
typ:=font_ttf;
flags:=font_flags_unicode+font_flags_vector;
end;


Procedure TFont_TTF.Load;
begin

end;


Function TFont_TTF.PripravZnak(w:word):PZnak;
{naplni promennou Znak definici pozadovaneho znaku}
begin

end;


Destructor TFont_TTF.Done;
begin
inherited Done;
end;



Constructor TFont_VGA.Init(s:string);
begin
inherited Init(s);
typ:=font_vga;
end;


Procedure TFont_VGA.Load;
var grp:TGRPstream;
    a,b,l:byte;
    i:longint;
    p:pbyte;
begin
if rez=font_VGA8 then l:=108 else
if rez=font_VGA14 then l:=114 else
if rez=font_VGA16 then l:=116
   else begin
   {budeme nacitat soubor, ne videoram}
   grp.init(rez,grpOpenRead);
   l:=grp.GetSize div 256;
   for a:=0 to 255 do grp.ReadStream(tempcharset[a,1],l);
   grp.Done;
   end;

if l>100 then
   begin
   dec(l,100);
   LoadVRAM(l);
   end;

case l of
   8:begin so:=7;su:=1;end;
   14:begin so:=13;su:=1;end;
   16:begin so:=14;su:=2;end;
   19:begin so:=16;su:=3;end;
end; {case}
vel:=so+su;
add:=0;
maxsirka:=9;

{Ted zbyva vyresit 9.bajt}
L:=vel;
for a:=0 to 255 do
    begin
    defznaku[a].Init;
    defznaku[a].relx:=0;
    defznaku[a].rely:=-so;
    defznaku[a].shift:=9;
    defznaku[a].sirka:=9;
    defznaku[a].vyska:=L;
    defznaku[a].dp:=L*9;
    GetMem(defznaku[a].data,L*9);
    p:=defznaku[a].data;
    for b:=0 to L-1 do
        begin
        i:=b*9;
        Expand(tempcharset[a,b+1],@p[i]);
        if (a>$b9) and (a<$e0) then p[i+8]:=p[i+7] else p[i+8]:=0;
        end;

    defznaku[a].Udelej_Proporcni;
    defznaku[a].Komprimuj;
    end;
end;


Procedure TFont_VGA.LoadVRAM(vyska:byte);
{Do tempfont zkopiruje VGA font o jehoz stazeni se postarala jednotka
 VenomGFX}
var fnt:PVGACharset;
    a:byte;
begin
case vyska of
   8:fnt:=@vga8charset;
  14:fnt:=@vga14charset;
  16:fnt:=@vga16charset;
end; {case}
for a:=0 to 255 do Move(fnt^[a,1],tempcharset[a,1],vyska);
end;


Function TFont_VGA.PripravZnak(w:word):PZnak;
{naplni promennou Znak definici pozadovaneho znaku}
var z:PZnak;
begin
z:=@defznaku[w];
PripravZnak:=z;
end;


Procedure TFont_VGA.SmazZnaky;
begin

end;


Destructor TFont_VGA.Done;
begin
inherited Done;
end;


Constructor TFont.Init(s:string;ivelikost:byte;icp:word);
{zanalyzuje vstupni format a podle to inicializuje prislusny motor}
var g:TGRPStream;
    p:string[64];
    i:longint;
begin
motor:=nil;
_err:=0;

velikost:=ivelikost;
cp:=icp;
rez:=UpString(s);

if s=font_VGA8 then motor:=New(PFont_VGA,Init(s)) else
if s=font_VGA14 then motor:=New(PFont_VGA,Init(s)) else
if s=font_VGA16 then motor:=New(PFont_VGA,Init(s));

if motor<>nil then
   begin
   motor^.Load;
   Exit;
   end;

g.Init(s,grpOpenRead);
if g.status=grpOK then
   begin
   p[0]:=#64;
   i:=g.ReadStream(p[1],64);
   if i=64 then
      begin
      if Copy(p,1,Length(fnmagic))=fnmagic then
         motor:=New(PFont_FN,Init(s))      else

      if Copy(p,1,Length(ufnmagic))=ufnmagic then
         motor:=New(PFont_UFN,Init(s))       else

      if CheckTTF_format(p) then
         motor:=New(PFont_TTF,Init(s)) else

      if CheckVGA(g.GetSize) then        {test na tenhle "format" by mel byt}
         motor:=New(PFont_VGA,Init(s));  {posledni}

      if motor<>nil then motor^.Load else _err:=255;
      end;
   g.Done;
   end;
end;


Function TFont.Error:byte;
begin
if _err<>0 then Error:=_err else Error:=motor^.error;
end;


Procedure TFont.PisZnak(x,y:longint;w:word;atrb:PFAtrb);
begin
PripravZnak(w);  {do promenne ZNAK nacte info o pismenu}


if (atrb^.flags and fatrb_prop)<>0 then
   inc(x,(motor^.maxsirka-znak^.sirka) div 2-1);

PutChar_FN(cil^,znak^.data,x,y,znak^.sirka,0{neimplementovano},znak^.vyska,znak^.dp,atrb^.barva);
end;


Procedure TFont.PripravZnak(w:word);
begin
znak:=motor^.PripravZnak(w);
end;


Function TFont.SirkaZnaku(atrb:PFAtrb):word;
{Pozor! Ve ZNAK musi byt procedurou PripravZnak pripraveny znak}
begin
if (atrb^.flags and fatrb_prop)=0 then SirkaZnaku:=znak^.shift+motor^.add
   else SirkaZnaku:=motor^.maxsirka;
end;



Destructor TFont.Done;
begin
Dispose(motor,Done);
end;


Constructor TFontJob.Init;
begin
cil:=@venomgfx.vga;
ox:=0;
oy:=0;
x:=0;
y:=0;
ox1:=-1;oy1:=-1;ox2:=-1;oy1:=-1;  {toto znamena, ze vyuziju celou velikost}
                                  {vystupniho VirtualWindow}
fromline:=true;                   {Y-souradnice bude urcovat pozici linky}
coding:=fcode_ascii;              {text ocekava jako ASCII}
ZalozZasobnik;
end;


Procedure TFontJob.ZalozZasobnik;
var a:TFatrb;
begin
a.rez:=font_vga16;
a.velikost:=bitmap_vel;
a.barva:=FN_global_barva;
a.flags:=0;
a.pozadi:=-1;

Atrbzas.Init(FN_zas_max,true);
UlozNaZasobnik(a);
end;


Procedure TFontJob.NactiAktZasobnik;
{Promennou Font nastavi podle vrcholu zasobniku}
begin

end;


Procedure TFontJob.NastavCil(p:pointer);
{P musi byt PVirtualWindow}
begin
cil:=p;
ox:=0;
oy:=0;
x:=0;
y:=0;
end;


Procedure TFontJob.NastavPozici(ix,iy:longint);
begin
x:=ix;
y:=iy;
ox:=ix;
oy:=oy;
end;


Procedure TFontJob.NastavAtrb(s:string);
{Nastavi atributy pomoci specifikacniho retezce. Format je:}
{R:rez B:barva V:velikost P:pozadi F:flags}
{nemusi byt specifikovane vsechny polozky - ty neurcene se zkopiruji z
drivejsiho zaznamu zasobniku}
begin

end;


Function TFontJob.VratAtrb:string;
var a:PFatrb;
    s:string;
begin
a:=atrbzas.Cti;
s:='R:'+a^.rez+' B:'+MyStr(a^.barva)+' V:'+MyStr(a^.velikost)+' P:'+MyStr(a^.pozadi)+' F:'+MyStr(a^.flags);
VratAtrb:=s;
end;


Procedure TFontJob.NastavBarvu(b:longint);
var a:PFatrb;
begin
a:=atrbzas.Cti;
a^.barva:=b;
end;


Function TFontJob.VratBarvu:longint;
var a:PFatrb;
begin
a:=atrbzas.Cti;
VratBarvu:=a^.barva;
end;


Procedure TFontJob.NastavRez(s:string);
var a:PFatrb;
begin
a:=atrbzas.Cti;
a^.rez:=s;
manager._lastatrb:=nil; {Manageru fontu musime dat na vedomi, ze novy font}
end;                    {nema prednacteny}


Function TFontJob.VratRez:string;
var a:PFatrb;
begin
a:=atrbzas.Cti;
VratRez:=a^.rez;
end;


Procedure TFontJob.NastavVelikost(b:byte);
var a:PFatrb;
begin
a:=atrbzas.Cti;
a^.velikost:=b;
end;


Function TFontJob.VratVelikost:byte;
var a:PFatrb;
begin
a:=atrbzas.Cti;
VratVelikost:=a^.velikost;
end;


Procedure TFontJob.NastavFlagy(b:byte);
var a:PFatrb;
begin
a:=atrbzas.Cti;
a^.flags:=b;
end;


Function TFontJob.VratFlagy:byte;
var a:PFatrb;
begin
a:=atrbzas.Cti;
VratFlagy:=a^.flags;
end;


Procedure TFontJob.NastavPozadi(b:longint);
var a:Pfatrb;
begin
a:=atrbzas.Cti;
a^.pozadi:=b;
end;


Function TFontJob.VratPozadi:longint;
var a:Pfatrb;
begin
a:=atrbzas.Cti;
VratPozadi:=a^.pozadi;
end;


Function TFontJob.CtiZnak(p:pchar;var a:longint):word;
{}Function PrvniCteni(q:pchar;var b:longint):word;
{}var w:word;
{}begin
{}case coding of
{}fcode_ascii:begin w:=byte(p[a]);inc(a);end;
{}fcode_utf8:begin end;
{}fcode_utf16:begin
              w:=byte(p[a]);
              if w=0 then inc(a) {nebo radeji inc(a,2)?}
                     else begin w:=word(p[a]);inc(a,2);end;
              end;
{}end; {case}
{}PrvniCteni:=w;
{}end;
var v1,v2:word;
    c:longint;
begin
v1:=PrvniCteni(p,a);
c:=a;
if v1=13 {CR, konec radky} then
   begin
   v2:=PrvniCteni(p,a);
   if v2<>10 {LF} then a:=c;
   end;
CtiZnak:=v1;
end;


Function TFontJob.PripravFont(h:PFatrb;w:word):pointer;
var f:PFont;
begin
f:=manager.PripravFont(h,w);
f^.cil:=cil;
PripravFont:=f;
end;


Procedure TFontJob.Print(p:pchar);
var w:word;
    a,b,yy:longint;
    konec:boolean;
    f:PFont;
    h:PFatrb;
begin
a:=0;
h:=atrbzas.Cti;
konec:=false;
ox:=x;
oy:=y;
repeat
   w:=CtiZnak(p,a);   {nacte znak z textu (podle toho, jake mame kodovani)}
                {inkrementace A je provedena automaticky funkci CtiZnak}
   case w of
   0:konec:=true;     {narazil na konec?}
   13:begin
      f:=PripravFont(h,w);
      x:=ox;
      inc(y,f^.motor^.vel);
      end;
   else begin
        f:=PripravFont(h,w); {pro kazde pismeno extra si bude zajistovat, aby}
                             {byl pripraveny font. Je to z duvodu, aby se v}
                             {pameti nemusely drzet cele velike unicode fonty}
        if f=nil then DebugFNT('PrintPChar: Nebyl pripaven font.');

        if fromline then yy:=y-f^.motor^.so
                    else yy:=y;

        f^.PisZnak(x,yy,w,h);
        b:=f^.SirkaZnaku(h);
        inc(x,b);
        end;

   end; {case}
until konec;
a:=a;
end;


Procedure TFontJob.Print(s:string);
begin
s:=s+#0;
Print(pchar(@s[1]));
end;


Function TFontJob.FontVyska:longint;
var h:PFatrb;
    f:PFont;
begin
h:=atrbzas.Cti;
f:=PripravFont(h,65{jakykoliv znak});
{zarucime, aby byl v pameti urcite spravny rez}
FontVyska:=f^.motor^.vel;
end;


Function TFontJob.TextVyska(p:pchar):longint;
var a,b,c:longint;
    w:word;
begin
a:=0;
b:=FontVyska;
c:=b;
repeat
   w:=CtiZnak(p,a);  {automaticky je provadena inkrementace A}
   if w=13 {CR} then inc(b,c);
until w=0;
TextVyska:=b;
end;

Function TFontJob.TextVyska(s:string):longint;
begin
s:=s+#0;
TextVyska:=TextVyska(pchar(@s[1]));
end;


Function TFontJob.FontSO:longint;
var h:PFatrb;
    f:PFont;
begin
h:=atrbzas.Cti;
f:=PripravFont(h,65{jakykoliv znak});
{zarucime, aby byl v pameti urcite spravny rez}
FontSO:=f^.motor^.so;
end;


Function TFontJob.FontSU:longint;
var h:PFatrb;
    f:PFont;
begin
h:=atrbzas.Cti;
f:=PripravFont(h,65{jakykoliv znak});
{zarucime, aby byl v pameti urcite spravny rez}
FontSU:=f^.motor^.su;
end;


Function TFontJob.TextSirka(p:pchar):longint;
var w:word;
    a,b,xr,xx:longint;
    konec:boolean;
    f:PFont;
    h:PFatrb;

begin
a:=0;
xx:=0;
xr:=0;
h:=atrbzas.Cti;
konec:=false;

repeat
   w:=CtiZnak(p,a);   {nacte znak z textu (podle toho, jake mame kodovani)}
                {inkrementace A je provedena automaticky funkci CtiZnak}
   case w of
   0:konec:=true;     {narazil na konec?}
   13:begin
      if xr>xx then xx:=xr;
      xr:=0;
      end;
   else begin
        f:=PripravFont(h,w); {pripravi spravny font}
        if f=nil then DebugFNT('TextSirka: Nebyl pripaven font.');
        f^.PripravZnak(w);   {a z fontu pripravi pismeno}
        b:=f^.SirkaZnaku(h);
        inc(xr,b);
        end;
   end; {case}
until konec;
if xr>xx then TextSirka:=xr-2 else TextSirka:=xx-2;
end;


Function TFontJob.TextSirka(s:string):longint;
begin
s:=s+#0;
TextSirka:=TextSirka(pchar(@s[1]));
end;

Procedure TFontJob.UlozNaZasobnik(a:TFAtrb);
var p:PFAtrb;
begin
New(p);
a.rez:=UpString(a.rez);
p^:=a;
atrbzas.Dej(p);
end;


Destructor TFontJob.Done;
begin

end;


Procedure TManager.Init;
var a:byte;
begin
for a:=1 to mngr_max do zaso[a]:=nil;
zasonum:=0;
_lastcp:=-1;
_lastatrb:=nil;
_lastfont:=nil;
end;


Function TManager.ShodaFontu(a:longint;atrb:PFatrb;cp:word):boolean;
var b:boolean;
begin
b:=(zaso[a]^.rez=atrb^.rez) and (zaso[a]^.velikost=atrb^.velikost);
if b=false then begin ShodaFontu:=false;Exit;end;
if (zaso[a]^.motor^.flags and font_flags_unicode)=0 then ShodaFontu:=true
   else {pozor, jde o unicode font, musime prozkoumat i kodovou stranku}
   if cp=zaso[a]^.cp then ShodaFontu:=true else ShodaFontu:=false;
end;


Function TManager.PripravFont(atrb:PFatrb;znak:word):PFont;
var cp:word;
    a,b:longint;
    p:PFont;

begin
cp:=znak div 256;  {prepocet na potrebnou "kodovou stranku"}

if (cp=_lastcp) and (atrb=_lastatrb)
   then begin PripravFont:=_lastfont;Exit;end;

_lastcp:=cp;
_lastatrb:=atrb;
b:=0;
for a:=1 to zasonum do
    if ShodaFontu(a,atrb,cp) then begin b:=a;break;end;

if b<>0 then
   begin
   _lastfont:=zaso[b]; {je-li v poli, tak ho vyzvedneme}
   PripravFont:=_lastfont;
   end
   else begin  {neni-li v poli, nacteme ho z disku (ci z VGA)}
   if zasonum=50 then     {je uz pole plne?}
      begin
      VycistiFonty;       {v tom pripade ho uplne vyprazdnime}
      zasonum:=0;         {ukazatel nastavim na nulu}
      end;
   inc(zasonum);
   p:=New(PFont,Init(atrb^.rez,atrb^.velikost,cp));
   zaso[zasonum]:=p;
   if p^.motor=nil then DebugFNT('Chyba pri nacitani fontu.');
   _lastfont:=p;
   PripravFont:=_lastfont;
   end;
end;


Procedure TManager.VycistiFonty;
begin
asm mov ax,3;int 10h;end;
writeln('Cisteni fontu jeste neni naprogramovano.');
end;


Procedure TManager.Load;
begin

end;

{Iniciealizacni cast jednotky}
begin
Manager.Init;  {zapne spravce fontu}


end.
