unit fontadat;
interface
uses VenomGFX,Objects,Lacrt,GrpFile;

const
SIPKA_OTOCENI_DOLEVA_DATA:array[1..72] of dword=
($F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81F0000,
$F81FF81F,$F81FF81F,$F81FF81F,$00,$F81FF81F,$F81FF81F,$F81FF81F,$00,$00,$00,
$F81FF81F,$F81F,$00,$00,$00,$F81FF81F,$F81F,$F81F0000,$F81F,$F81F0000,
$F81FF81F,$F81F,$F81FF81F,$00,$F81FF81F,$F81FF81F,$F81FF81F,$F81F,$F81F0000,
$F81FF81F,$F81FF81F,$F81FF81F,$00,$F81FF81F,$F81FF81F,$F81FF81F,$F81F,
$F81F0000,$F81FF81F,$F81FF81F,$F81FF81F,$00,$F81FF81F,$F81FF81F,$F81FF81F,
$F81F,$F81F0000,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,
$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,
$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F);
SIPKA_OTOCENI_DOLEVA_WIDTH=9;
SIPKA_OTOCENI_DOLEVA_HEIGHT=16;


SIPKA_OTOCENI_DOPRAVA_DATA:array[1..72] of dword=
($F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,
$F81F0000,$F81FF81F,$F81FF81F,$F81FF81F,$F81F,$F81F0000,$F81FF81F,$F81F,$00,
$00,$F81F0000,$F81F,$00,$00,$00,$F81FF81F,$00,$F81FF81F,$00,$F81FF81F,$F81F,
$F81F0000,$F81F,$F81FF81F,$F81FF81F,$00,$F81FF81F,$F81FF81F,$F81FF81F,$F81F,
$F81F0000,$F81FF81F,$F81FF81F,$F81FF81F,$00,$F81FF81F,$F81FF81F,$F81FF81F,
$F81F,$F81F0000,$F81FF81F,$F81FF81F,$F81FF81F,$00,$F81FF81F,$F81FF81F,
$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,
$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,
$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F,$F81FF81F);
SIPKA_OTOCENI_DOPRAVA_WIDTH=9;
SIPKA_OTOCENI_DOPRAVA_HEIGHT=16;


type BMP_header = packed record
{00}         magic:word;
{02}         sizebmp:longint;
{06}         reserved:longint;
{10}         offset_to_data:longint;
{14}         header_size:longint;
{18}         width:longint;
{22}         height:longint;
{26}         numplanes:word;
{28}         bits_per_pixel:word;
{30}         compressed:longint;
{34}         sizeimage:longint;
{38}         xres:longint;
{42}         yres:longint;
{46}         clrused:longint;
{50}         clrimportant:longint;
             end;

Function LoadBMPheader(s:string;var pal:pBGRApalette;var header:BMP_header;var h:PStream):byte;
Procedure LoadBMPlines(var h:PStream;pal:pBGRApalette;buf:pointer;var header:BMP_header;var w:virtualwindow;var precteno:longint);


Function Load_Unicode_Char_Name(i:longint;var s,s2:string;var priz:longint):char;
{I    = cislo znaku,
 S    = vraceny retezec
 S2   = vracene oznaceni useku
 PRIZ = bit 0 (1=pismo zprava doleva, 0 = ostatni pripady
 vysledek: C/Z/U/E (control/znak/undefined/error)}


implementation
Procedure LoadBMPlines(var h:PStream;pal:pBGRApalette;buf:pointer;var header:BMP_header;var w:virtualwindow;var precteno:longint);
var p,i,x,y:longint;
    cil:PByte;
begin
cil:=pointer(w.vwoffset);
inc(cil,w.bytebreite*(w.hoehe-1)); {levy dolni roh}
p:=header.width*header.bits_per_pixel div 8+header.xres;
precteno:=0;
if pal<>nil then  {8 bitove BMP s paletou}
   begin
   for i:=1 to w.hoehe do
       begin        {8 bitove BMP}
       h^.Read(buf^,p);              {ze souboru nactu radku}
       if h^.GetPos>=h^.GetSize then Exit;
       if h^.ErrorInfo<>0 then Exit;
       inc(precteno);
       x:=header.width;
       asm
           mov esi,buf
           mov ebx,pal
           mov edi,cil
       @cykl:
           movzx eax,byte [esi];
           inc esi
           shl eax,2
           movzx edx,byte [ebx+eax]
           inc eax
           movzx ecx,byte [ebx+eax]
           shl ecx,5
           or edx,ecx
           inc eax
           movzx ecx,byte [ebx+eax]
           shl ecx,11
           or edx,ecx
           mov [edi],dx;
           add edi,2
           dec x
           jnz @cykl
       end;
       dec(cil,w.bytebreite);  {BMP jsou totiz ukladane zespodu nahoru}
       end;
   end
   else
   begin

   for i:=1 to w.hoehe do
    begin           {24 bitove BMP}
    h^.Read(buf^,p);
    if h^.ErrorInfo<>0 then Exit;
    inc(precteno);
    x:=header.width;
        asm
        mov ecx,x
        mov esi,buf
        mov edi,cil
    @cykl:
        mov al,[esi]
        shr al,3
        movzx bx,al
        inc esi
        movzx ax, byte [esi]
        shr ax,2
        shl ax,5
        add bx,ax
        inc esi
        movzx ax, byte [esi]
        shr ax,3
        shl ax,11
        add bx,ax
        inc esi
        mov [edi],bx
        add edi,2
        loop @cykl
        end;
    end;
    end;
end;

Function LoadBMPheader(s:string;var pal:pBGRApalette;var header:BMP_header;var h:PStream):byte;
var p,y,d:longint;
begin
h:=New(PBufStream,Init(s,stOpenRead,30000));
h^.read(header,sizeof(header));
if (header.magic<>$4d42) or (header.compressed<>0) or (not (header.bits_per_pixel in [8,24])) then
   Exit(1);

if header.bits_per_pixel=8 then
   begin
   New(pal);
   h^.read(pal^,256*4);
   for y:=0 to 255 do
       begin
       pal^[y].r:=pal^[y].r shr 3;
       pal^[y].g:=pal^[y].g shr 2;
       pal^[y].b:=pal^[y].b shr 3;
       end;
   d:=(header.width mod 4);
   if d<>0 then d:=4-d;
   header.xres:=d;    {pomocnou promennou D budu potrebovat v nacitaci radku}
   end
   else begin
   if header.bits_per_pixel<>24 then Exit(2);
   pal:=nil;
   d:=(header.width mod 4);
   header.xres:=d;
   end;
h^.seek(header.offset_to_data);
LoadBMPheader:=0;
end;


Function Load_Unicode_Char_Name(i:longint;var s,s2:string;var priz:longint):char;
{I    = cislo znaku,
 S    = vraceny retezec
 S2   = vracene oznaceni useku
 PRIZ = bit 0 (1=pismo zprava doleva, 0 = ostatni pripady
 vysledek: C/Z/U/E (control/znak/undefined/error)}
var g1,g2,g3:TGrpStream;
    j,jk,jr,jrs:longint;
    k:byte;
    z:char;
    u,w:string;

begin
if (i<0) or (i>65535) then
   begin s:='Code out of range';s2:='Invalid range';Exit('E');end;

g1.Init(ExeDir+'fontana.grp#uniidx.inf',grpOpenRead);
g1.Seek(i*4);
g1.Read(j,4);
g1.Done;

jk:=j and $fffff;
jr:=j shr 20;

{writeln(j,' : ',jr);}

g3.Init(ExeDir+'fontana.grp#uniran.txt',grpOpenRead);
g3.Seek(jr);
w:=g3.ReadString;
g3.Done;
if w[1]='*' then jrs:=1 else jrs:=0;
priz:=jrs;
k:=Length(w)-jrs;
s2[0]:=char(k);
Move(w[1+jrs],s2[1],k);

if jk=$FFFFF then begin s:='Undefined Unicode code';Exit('U');end;

g2.Init(ExeDir+'fontana.grp#uni-ffff.txt',grpOpenRead);
g2.Seek(jk);
u:=g2.ReadString;
g2.Done;
if u[1]='z' then z:='Z' else z:='C';

k:=Length(u)-2;

s[0]:=char(k);
Move(u[3],s[1],k);

Load_Unicode_Char_Name:=z;
end;

end.
