{****************************************************************************}
{Unit VNM_PNG - it is a addon unit for graphics library VenomGFX.            }
{It bring a loader for .PNG graphics files                                   }
{      written by Michael Knapp, adjusted by Laaca                           }
{****************************************************************************}
unit vnm_PNG;
{$IFDEF VER2}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF VER3}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF NEWFPC}{$CALLING OLDFPCCALL}{$ENDIF}

{$ASMMODE INTEL}
{$RANGECHECKS OFF} {These directives must be turned off else decoder}
{$Q-}              {won't work}

interface
uses VenomGFX;


Function Load_PNG(s:string;var w:virtualwindow):byte;
{virtualwindow W will be initialized inside loader}


implementation
uses GRPfile,VenomMng,objects;


const bytperpix = 2;
TYPE PImage=^TImage;
     TImage=packed RECORD
       width:longint;
       height:longint;
       bytesperline:dword;
       bytesperpixel:dword;
       size:dword;
       pixeldata:pointer;
       flags:dword;
       transparencycolor:dword;
       originX,originY:longint;
       vx1,vy1,vx2,vy2:longint;
     END;


PROCEDURE swap32(var p);assembler;
ASM
  MOV EDI,p
  MOV EAX,[EDI]
  XCHG AL,AH
  ROL EAX,16
  XCHG AL,AH
  MOV [EDI],EAX
END;


Function CreateImageWH(width,height:longint):pimage;
var p:PImage;
begin
New(p);
p^.width:=width;
p^.height:=height;
p^.bytesperline:=width*2;
p^.bytesperpixel:=2;
p^.size:=width*height*2;
GetMem(p^.pixeldata,p^.size);
CreateImageWH:=p;
end;

Function ZkontrolujFormat(stream:pstream):byte;
const hlavicka_png:array[0..7] of byte =
      ($89,$50,$4e,$47,$0d,$0a,$1a,$0a);
var tt:array[0..7] of byte;
begin
FillDword(tt,2,0);
stream^.read(tt,8);
if comparebyte(tt,hlavicka_png,8)=0
   then ZkontrolujFormat:=0
   else ZkontrolujFormat:=1;
stream^.seek(0);
end;


{========================== LoadImagePNG ==================================}

FUNCTION LoadImagePNG(stream:pstream;var img:pimage;nr:longint):longint;

{-------------------------- INFLATE.C -------------------------------------}

{
  inflate.c -- Not copyrighted 1992 by Mark Adler
               version c10p1, 10 January 1993
  Adapted for booting Linux by Hannu Savolainen 1993
  based on gzip-1.0.3

  Freepascal-Conversion and Adaption for PNG-Loader
  by Michael Knapp, Dec 21st, 1999

}

TYPE
  int=longint;
  uch=byte;
  ulg=dword;
  unsigned=dword;
  ush=word;

  pint=^int;
  puch=^uch;
  puld=^ulg;
  punsigned=^unsigned;
  push=^ush;

  plongint=^longint;

  pphuft=^phuft;
  phuft=^huft;
  huft=RECORD
    e:uch;           { number of extra bits or operation }
    b:uch;           { number of bits in this code or subcode }
    v:RECORD
        CASE smallint OF
        0:(n:ush);   { literal, length base, or distance base }
        1:(t:phuft)  { pointer to next level of table }
        END;
  END;

TYPE pbyte=^byte;

     tfourcc=array[0..3] of char;
     TPNGsig=array[0..7] of byte;

     TPNGchunk=RECORD
       size:longint;
       name:tfourcc;
     END;

     IHDR_t=RECORD
       width:longint;
       height:longint;
       bitdepth:byte;
       colortype:byte;
       compressiontype:byte;
       filtertype:byte;
       interlacetype:byte;
     END;

     PLTE_t=array[0..255,0..2] of byte;

CONST
  WSIZE=$8000;

TYPE
  Window=array[0..WSIZE-1] of byte;
  pWindow=^Window;

CONST
  border:array[0..18] of unsigned= { Order of the bit length code lengths }
    (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15);
  cplens:array[0..30] of ush=      { Copy lengths for literal codes 257..285 }
    (3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
     35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0);
  cplext:array[0..30] of ush=      { Extra bits for literal codes 257..285 }
    (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2,
     3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, 99, 99);
  cpdist:array[0..29] of ush=      { Copy offsets for distance codes 0..29 }
    (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193,
     257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
     8193, 12289, 16385, 24577);
  cpdext:array[0..29] of ush=      { Extra bits for distance codes }
    (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6,
     7, 7, 8, 8, 9, 9, 10, 10, 11, 11,
     12, 12, 13, 13);

  mask_bits:array[0..16] of ush=
      ($0000,
       $0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff,
       $01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff);


  lbits:int=9; { bits in base literal/length lookup table }
  dbits:int=6; { bits in base distance lookup table }

  { If BMAX needs to be larger than 16, then h and x[] should be ulg. }
  BMAX=16;     { maximum bit length of any code (16 for explode) }
  N_MAX=288;   { maximum number of codes in any set }


  FUNCTION cmp(f1,f2:tfourcc):boolean;
  BEGIN
    cmp:=((f1[0]=f2[0]) AND (f1[1]=f2[1]) AND (f1[2]=f2[2]) AND (f1[3]=f2[3]));
  END;

VAR
  hufts:unsigned; { track memory usage }

  FUNCTION huft_build(b:punsigned; { code lengths in bits (all assumed <= BMAX) }
                      n:unsigned;  { number of codes (assumed <= N_MAX) }
                      s:unsigned;  { number of simple-valued codes (0..s-1) }
                      d:push;      { list of base values for non-simple codes }
                      e:push;      { list of extra bits for non-simple codes }
                      t:pphuft;    { result: starting table }
                      m:pint       { maximum lookup bits, returns actual }
                     ):int;
  { Given a list of code lengths and a maximum table size, make a set of
    tables to decode that set of codes.  Return zero on success, one if
    the given code set is incomplete (the tables are still built in this
    case), two if the input is invalid (all zero length codes or an
    oversubscribed set of lengths), and three if not enough memory. }
  VAR
    a:unsigned;                      { counter for codes of length k }
    c:array[0..BMAX] of unsigned;    { bit length count table }
    f:unsigned;                      { i repeats in table every f entries }
    g:int;                           { maximum code length }
    h:int;                           { table level }
    i:unsigned;                      { counter, current code }
    j:unsigned;                      { counter }
    k:int;                           { number of bits in current code }
    l:int;                           { bits per table (returned in m) }
    p:punsigned;                     { pointer into c[], b[], or v[] }
    q:phuft;                         { points to current table }
    r:huft;                          { table entry for structure assignment }
    u:array[0..BMAX-1] of phuft;     { table stack }
    v:array[0..N_MAX-1] of unsigned; { values in order of bit length }
    w:int;                           { bits before this table == (l * h) }
    x:array[0..BMAX] of unsigned;    { bit offsets, then code stack }
    xp:punsigned;                    { pointer into x }
    y:int;                           { number of dummy codes added }
    z:unsigned;                      { number of entries in current table }
  BEGIN
    { Generate counts for each bit length }
    fillchar(c,sizeof(c),0);
    p:=b;
    i:=n;
    REPEAT
      inc(c[p^]);
      inc(p);
      dec(i);  { assume all entries <= BMAX }
    UNTIL (i=0);
    IF (c[0]=n) THEN { null input--all zero length codes }
      BEGIN
        t^:=nil;
        m^:=0;
        huft_build:=0;
        exit;
      END;
    { Find minimum and maximum length, bound *m by those }
    l:=m^;
    FOR j:=1 TO BMAX DO
      IF (c[j]<>0) THEN break;
    k:=j; { minimum code length }
    IF (unsigned(l)<j) THEN l:=j;
    FOR i:=BMAX DOWNTO 1 DO
      IF (c[i]<>0) THEN break;
    g:=i; { maximum code length }
    IF (unsigned(l)>i) THEN l:=i;
    m^:=l;
    { Adjust last length count to fill out codes, if needed }
    y:=1 SHL j;
    WHILE (j<i) DO
      BEGIN
        dec(y,c[j]);
        IF (y<0) THEN
          BEGIN
            huft_build:=2; { bad input: more codes than bits }
            exit;
          END;
        inc(j);
        y:=y SHL 1;
      END;
    dec(y,int(c[i]));
    IF (y<0) THEN
      BEGIN
        huft_build:=2; { bad input: more codes than bits }
        exit;
      END;
    inc(c[i],y);
    { Generate starting offsets into the value table for each length }
    x[1]:=0;
    j:=0;
    p:=c;inc(p);
    xp:=x;inc(xp,2);
    dec(i);
    WHILE (i<>0) DO { note that i == g from above }
      BEGIN
        inc(j,p^);
        inc(p);
        xp^:=j;
        inc(xp);
        dec(i);
      END;
    { Make a table of values in order of bit lengths }
    p:=b;
    i:=0;
    REPEAT
      j:=p^;
      inc(p);
      IF (j<>0) THEN
        BEGIN
         v[x[j]]:=i;
         inc(x[j]);
        END;
      inc(i);
    UNTIL (i>=n);
    { Generate the Huffman codes and for each, make the table entries }
    x[0]:=0;    { first Huffman code is zero }
    i:=0;
    p:=v;       { grab values in bit order }
    h:=-1;      { no tables yet--level -1 }
    w:=-l;      { bits decoded == (l * h) }
    u[0]:=nil;  { just to keep compilers happy }
    q:=nil;     { ditto }
    z:=0;       { ditto }
    { go through the bit lengths (k already is bits in shortest code) }
    WHILE (k<=g) DO
      BEGIN
        a:=c[k];
        WHILE (a<>0) DO
          BEGIN
            dec(a);
            { here i is the Huffman code of length k bits for value *p }
            { make tables up to required level }
            WHILE (k>w+l) DO
              BEGIN
                inc(h);
                inc(w,l); { previous table always l bits }
                { compute minimum size table less than or equal to l bits }
                z:=g-w;
                IF (z>unsigned(l)) THEN z:=l; { upper limit on table size }
                j:=k-w; { try a k-w bit table }
                f:=1 SHL j;
                IF (f>a+1) THEN
                  BEGIN
                    dec(f,a+1); { deduct codes from patterns left }
                    xp:=c;inc(xp,k);
                    inc(j);
                    WHILE (j<z) DO { try smaller tables up to z bits }
                      BEGIN
                        f:=f SHL 1;
                        inc(xp);
                        IF (f<=xp^) THEN break; { enough codes to use up j bits }
                        dec(f,xp^); { else deduct codes from patterns }
                        inc(j);
                      END;
                  END;
                z:=1 SHL j; { table entries for j-bit table }
                { allocate and link in new table }
                getmem(q,4+(z+1)*sizeof(huft));
                plongint(q)^:=4+(z+1)*sizeof(huft);
{DBG(plongint(p)^);}
                inc(pointer(q),4);
                inc(hufts,z+1); { track memory usage }
                t^:=q;inc(t^);  { link to list for huft_free() }
                t:=addr(q^.v.t);
                t^:=nil;
                inc(q);
                u[h]:=q; { table starts after link }
                { connect to last table, if there is one }
                IF (h<>0) THEN
                  BEGIN
                    x[h]:=i;             { save pattern for backing up }
                    r.b:=uch(l);         { bits to dump before this table }
                    r.e:=uch(16+j);      { bits in this table }
                    r.v.t:=q;            { pointer to this table }
                    j:=i SHR (w-l);      { (get around Turbo C bug) }
                    u[h-1][j]:=r;        { connect to last table }
                  END;
              END;
            { set up table entry in r }
            r.b:=uch(k-w);
            IF (dword(p)>=dword(@(v[n]))) THEN
              BEGIN
                r.e:=99; { out of values--invalid code }
              END
            ELSE IF (p^<s) THEN
              BEGIN
                IF (p^<256) THEN r.e:=16 ELSE r.e:=15; { 256 is end-of-block code }
                r.v.n:=p^; { simple code is just the value }
                inc(p);
              END
            ELSE
              BEGIN
                r.e:=uch(e[p^-s]); { non-simple--look up in lists }
                r.v.n:=d[p^-s];
                inc(p);
              END;
            { fill code-like entries with r }
            f:=1 SHL (k-w);
            j:=i SHR w;
            WHILE (j<z) DO
              BEGIN
                q[j]:=r;
                inc(j,f);
              END;
            { backwards increment the k-bit code i }
            j:=1 SHL (k-1);
            WHILE ((i AND j)<>0) DO
              BEGIN
                i:=i XOR j;
                j:=j SHR 1;
              END;
            i:=i XOR j;
            { backup over finished tables }
            WHILE ((i AND ((1 SHL w) - 1))<>x[h]) DO
              BEGIN
                dec(h);
                dec(w,l);
              END;
          END;
        dec(a);
        inc(k);
      END;
    { Return true (1) if we were given an incomplete table }
    IF ((y<>0) AND (g<>1)) THEN huft_build:=1 ELSE huft_build:=0;
  END;

  FUNCTION huft_free(t:phuft):int;
  { Free the malloc'ed tables built by huft_build(), which makes a linked
    list of the tables it made, with the links in a dummy first entry of
    each table. }
  VAR p,q:phuft;
  BEGIN
  { Go through linked list, freeing from the malloced (t[-1]) address. }
    p:=t;
    WHILE (p<>nil) DO
      BEGIN
        dec(p);
        q:=p^.v.t;
        dec(pointer(p),4);
{DBG(plongint(p)^);}
        freemem(p,plongint(p)^);
        p:=q;
      END;
    huft_free:=0;
  END;

VAR
  slide:pWindow;
  IDATcount:longint;
  bb:ulg;      { bit buffer }
  bk:unsigned; { bits in bit buffer }
  wp:longint;    { current position within slide }

  FUNCTION NEXTBYTE:uch;
  VAR b:byte;
      PNGchunk:TPNGchunk;
      PNGchunkCRC:longint;
      curpos:longint;
  BEGIN
{DBGns;
DBG(IDATcount);
IF (IDATcount<10) THEN DBGw(IDATcount);}
    IF (IDATcount=0) THEN
      BEGIN
        curpos:=stream^.getpos;
        stream^.read(PNGchunkCRC,4);
        stream^.read(PNGchunk,sizeof(PNGchunk));
        swap32(PNGchunk.size);
        IF cmp(PNGchunk.name,'IDAT') THEN
          BEGIN
            IDATcount:=PNGchunk.size;
          END
        ELSE
          BEGIN
            stream^.seek(curpos);
          END;
      END;
    IF (IDATcount>0) THEN
      BEGIN
        stream^.read(b,1);
        NEXTBYTE:=b;
        dec(IDATcount);
      END;
  END;

  PROCEDURE NEEDBITS(var b:ulg;var k:unsigned;n:unsigned);
  BEGIN
    WHILE (k<n) DO
      BEGIN
        b:=b OR ulg(NEXTBYTE) SHL k;
        inc(k,8);
      END;
  END;

  PROCEDURE DUMPBITS(var b:ulg;var k:unsigned;n:unsigned);
  BEGIN
    b:=b SHR n;
    dec(k,n);
  END;

  PROCEDURE flush_output(w:longint);forward;

  FUNCTION inflate_codes(tl:phuft; { literal/length and distance decoder tables }
                         td:phuft; { number of bits decoded by tl[] and td[] }
                         bl:int;
                         bd:int
                        ):int;
   { inflate (decompress) the codes in a deflated (compressed) block.
     Return an error code or zero if it all goes ok. }
  VAR
    e:unsigned;     { table entry flag/number of extra bits }
    n,d:unsigned;   { length and index for copy }
    w:longint;      { current window position }
    t:phuft;        { pointer to table entry }
    ml,md:unsigned; { masks for bl and bd bits }
    b:ulg;          { bit buffer }
    k:unsigned;     { number of bits in bit buffer }
  BEGIN
    { make local copies of globals }
    b:=bb;                       { initialize bit buffer }
    k:=bk;
    w:=wp;                       { initialize window position }
    { inflate the coded data }
    ml:=mask_bits[bl];           { precompute masks for speed }
    md:=mask_bits[bd];
    WHILE TRUE DO                { do until end of block }
      BEGIN
        NEEDBITS(b,k,unsigned(bl));
        t:=tl;inc(t,unsigned(b) AND ml);
        e:=t^.e;
        IF (e>16) THEN
          REPEAT
            IF (e=99) THEN
              BEGIN
                inflate_codes:=1;
                exit;
              END;
            DUMPBITS(b,k,t^.b);
            dec(e,16);
            NEEDBITS(b,k,e);
            t:=t^.v.t;inc(t,(unsigned(b) AND mask_bits[e]));
            e:=t^.e;
          UNTIL (e<=16);
        DUMPBITS(b,k,t^.b);
        IF (e=16) THEN { then it's a literal }
          BEGIN
            slide^[w]:=uch(t^.v.n);
            inc(w);
            IF (w=WSIZE) THEN
              BEGIN
                flush_output(w);
                w:=0;
              END;
          END
        ELSE { it's an EOB or a length }
          BEGIN
            { exit if end of block }
            IF (e=15) THEN break;
            { get length of block to copy }
            NEEDBITS(b,k,e);
            n:=t^.v.n+(unsigned(b) AND mask_bits[e]);
            DUMPBITS(b,k,e);
            { decode distance of block to copy }
            NEEDBITS(b,k,unsigned(bd));
            t:=td;inc(t,(unsigned(b) AND md));
            e:=t^.e;
            IF (e>16) THEN
              REPEAT
                IF (e=99) THEN
                  BEGIN
                    inflate_codes:=1;
                    exit;
                  END;
                DUMPBITS(b,k,t^.b);
                dec(e,16);
                NEEDBITS(b,k,e);
                t:=t^.v.t;inc(t,(unsigned(b) AND mask_bits[e]));
                e:=t^.e;
              UNTIL (e<=16);
            DUMPBITS(b,k,t^.b);
            NEEDBITS(b,k,e);
            d:=w-t^.v.n-(unsigned(b) AND mask_bits[e]);
            DUMPBITS(b,k,e);
            { do the copy }
            REPEAT
              d:=d AND (WSIZE-1);
              IF (d>w) THEN e:=WSIZE-d ELSE e:=WSIZE-w;
              IF (e>n) THEN e:=n;
              dec(n,e);
              REPEAT
                slide^[w]:=slide^[d];
                inc(w);
                inc(d);
                dec(e);
              UNTIL (e=0);
              IF (w=WSIZE) THEN
                BEGIN
                  flush_output(w);
                  w:=0;
                END;
            UNTIL (n=0);
          END;
      END;
    { restore the globals from the locals }
    wp:=w; { restore global window pointer }
    bb:=b; { restore global bit buffer }
    bk:=k;
    { done }
    inflate_codes:=0;
  END;

  FUNCTION inflate_stored:int;
  { "decompress" an inflated type 0 (stored) block. }
  VAR
    n:unsigned; { number of bytes in block }
    w:longint;    { current window position }
    b:ulg;      { bit buffer }
    k:unsigned; { number of bits in bit buffer }
  BEGIN
    { make local copies of globals }
    b:=bb; { initialize bit buffer }
    k:=bk;
    w:=wp; { initialize window position }
    { go to byte boundary }
    n:=k AND 7;
    DUMPBITS(b,k,n);
    { get the length and its complement }
    NEEDBITS(b,k,16);
    n:=(unsigned(b) AND $ffff);
    DUMPBITS(b,k,16);
    NEEDBITS(b,k,16);
    IF (n<>unsigned((NOT b) AND $ffff)) THEN
      BEGIN
        inflate_stored:=1;                   { error in compressed data }
        exit;
      END;
    DUMPBITS(b,k,16);
    { read and output the compressed data }
    WHILE (n>0) DO
      BEGIN
        dec(n);
        NEEDBITS(b,k,8);
        slide^[w]:=uch(b);
        inc(w);
        IF (w=WSIZE) THEN
          BEGIN
            flush_output(w);
            w:=0;
          END;
        DUMPBITS(b,k,8);
      END;
    { restore the globals from the locals }
    wp:=w; { restore global window pointer }
    bb:=b; { restore global bit buffer }
    bk:=k;
    inflate_stored:=0;
  END;

  FUNCTION inflate_fixed:int;
  { decompress an inflated type 1 (fixed Huffman codes) block.  We should
     either replace this with a custom decoder, or at least precompute the
     Huffman tables. }
  VAR
    i:int;                       { temporary variable }
    tl:phuft;                    { literal/length code table }
    td:phuft;                    { distance code table }
    bl:int;                      { lookup bits for tl }
    bd:int;                      { lookup bits for td }
    l:array[0..287] of unsigned; { length list for huft_build }
  BEGIN
    { set up literal table }
    FOR i:=0   TO 143 DO l[i]:=8;
    FOR i:=144 TO 255 DO l[i]:=9;
    FOR i:=256 TO 279 DO l[i]:=7;
    FOR i:=280 TO 287 DO l[i]:=8; { make a complete, but wrong code set }
    bl:=7;
    i:=huft_build(@l,288,257,@cplens,@cplext,@tl,@bl);
    IF (i<>0) THEN
      BEGIN
        inflate_fixed:=i;
        exit;
      END;
    { set up distance table }
    FOR i:=0 TO 29 DO l[i]:=5; { make an incomplete code set }
    bd:=5;
    i:=huft_build(@l,30,0,@cpdist,@cpdext,@td,@bd);
    IF (i>1) THEN
      BEGIN
        huft_free(tl);
        inflate_fixed:=i;
        exit;
      END;
    { decompress until an end-of-block code }
    IF (inflate_codes(tl,td,bl,bd)<>0) THEN
      BEGIN
        inflate_fixed:=1;
        huft_free(tl);
        huft_free(td);
        exit;
      END;
    { free the decoding tables, return }
    huft_free(tl);
    huft_free(td);
    inflate_fixed:=0;
  END;

  FUNCTION inflate_dynamic:int;
  { decompress an inflated type 2 (dynamic Huffman codes) block. }
  VAR
    i:int;                             { temporary variables }
    j:unsigned;
    l:unsigned;                        { last length }
    m:unsigned;                        { mask for bit lengths table }
    n:unsigned;                        { number of lengths to get }
    tl:phuft;                          { literal/length code table }
    td:phuft;                          { distance code table }
    bl:int;                            { lookup bits for tl }
    bd:int;                            { lookup bits for td }
    nb:unsigned;                       { number of bit length codes }
    nl:unsigned;                       { number of literal/length codes }
    nd:unsigned;                       { number of distance codes }
    ll:array[0..286+30-1] of unsigned; { literal/length and distance code lengths }
    b:ulg;                             { bit buffer }
    k:unsigned;                        { number of bits in bit buffer }
  BEGIN
    { make local bit buffer }
    b:=bb;
    k:=bk;
    { read in table lengths }
    NEEDBITS(b,k,5);
    nl:=257+(unsigned(b) AND $1f);      { number of literal/length codes }
    DUMPBITS(b,k,5);
    NEEDBITS(b,k,5);
    nd:=1+(unsigned(b) AND $1f);        { number of distance codes }
    DUMPBITS(b,k,5);
    NEEDBITS(b,k,4);
    nb:=4+(unsigned(b) AND $f);         { number of bit length codes }
    DUMPBITS(b,k,4);
    IF ((nl>286) OR (nd>30)) THEN
      BEGIN
        inflate_dynamic:=1;
        exit;  { bad lengths }
      END;
    { read in bit-length-code lengths }
    FOR j:=0 TO nb-1 DO
      BEGIN
        NEEDBITS(b,k,3);
        ll[border[j]]:=unsigned(b) AND 7;
        DUMPBITS(b,k,3);
      END;
    FOR j:=nb TO 18 DO
      BEGIN
        ll[border[j]]:=0;
      END;
    { build decoding table for trees--single level, 7 bit lookup }
    bl:=7;
    i:=huft_build(ll,19,19,nil,nil,@tl,@bl);
    IF (i<>0) THEN
      BEGIN
        IF (i=1) THEN huft_free(tl);
        inflate_dynamic:=i;                   { incomplete code set }
        exit;
      END;
    { read in literal and distance code lengths }
    n:=nl+nd;
    m:=mask_bits[bl];
    i:=0;
    l:=0;
    WHILE (unsigned(i)<n) DO
      BEGIN
        NEEDBITS(b,k,unsigned(bl));
        td:=tl;inc(td,(unsigned(b) AND m));
        j:=td^.b;
        DUMPBITS(b,k,j);
        j:=td^.v.n;
        IF (j<16) THEN      { length of code in bits (0..15) }
          BEGIN
            l:=j;
            ll[i]:=j;          { save last length in l }
            inc(i);
          END
        ELSE IF (j=16) THEN { repeat last length 3 to 6 times }
          BEGIN
            NEEDBITS(b,k,2);
            j:=3+(unsigned(b) AND 3);
            DUMPBITS(b,k,2);
            IF (unsigned(i)+j>n) THEN
              BEGIN
                inflate_dynamic:=1;
                exit;
              END;
            WHILE (j<>0) DO
              BEGIN
                dec(j);
                ll[i]:=l;
                inc(i);
              END;
          END
        ELSE IF (j=17) THEN { 3 to 10 zero length codes }
          BEGIN
            NEEDBITS(b,k,3);
            j:=3+(unsigned(b) AND 7);
            DUMPBITS(b,k,3);
            IF (unsigned(i)+j>n) THEN
              BEGIN
                inflate_dynamic:=1;
                exit;
              END;
            WHILE (j<>0) DO
              BEGIN
                dec(j);
                ll[i]:=0;
                inc(i);
              END;
            l:=0;
          END
        ELSE                { j == 18: 11 to 138 zero length codes }
          BEGIN
            NEEDBITS(b,k,7);
            j:=11+(unsigned(b) AND $7f);
            DUMPBITS(b,k,7);
            IF (unsigned(i)+j>n) THEN
              BEGIN
                inflate_dynamic:=1;
                exit;
              END;
            WHILE (j<>0) DO
              BEGIN
                dec(j);
                ll[i]:=0;
                inc(i);
              END;
            l:=0;
          END;
      END;
    { free decoding table for trees }
    huft_free(tl);
    { restore the global bit buffer }
    bb:=b;
    bk:=k;
    { build the decoding tables for literal/length and distance codes }
    bl:=lbits;
    i:=huft_build(ll,nl,257,cplens,cplext,@tl,@bl);
    IF (i<>0) THEN
      BEGIN
        IF (i=1) THEN
          BEGIN
            { error(" incomplete literal tree\n"); }
            huft_free(tl);
          END;
        inflate_dynamic:=i;                   { incomplete code set }
        exit;
      END;
    bd:=dbits;
    i:=huft_build(@(ll[nl]),nd,0,cpdist,cpdext,@td,@bd);
    IF (i<>0) THEN
      BEGIN
        IF (i=1) THEN
          BEGIN
            {error(" incomplete distance tree\n");}
            huft_free(td);
          END;
        huft_free(tl);
        inflate_dynamic:=i;                   { incomplete code set }
        exit;
      END;
    { decompress until an end-of-block code }
    IF (inflate_codes(tl,td,bl,bd)<>0) THEN
      BEGIN
        inflate_dynamic:=1;
        exit;
      END;
    { free the decoding tables, return }
    huft_free(tl);
    huft_free(td);
    inflate_dynamic:=0;
  END;

  FUNCTION inflate_block(e:pint { last block flag }
                        ):int;
  { decompress an inflated block }
  VAR
    t:unsigned;  { block type }
    b:ulg;       { bit buffer }
    k:unsigned;  { number of bits in bit buffer }
  BEGIN
    { make local bit buffer }
    b:=bb;
    k:=bk;
    { read in last block bit }
    NEEDBITS(b,k,1);
    e^:=int(b) AND 1;
    DUMPBITS(b,k,1);
    { read in block type }
    NEEDBITS(b,k,2);
    t:=unsigned(b) AND 3;
    DUMPBITS(b,k,2);
    { restore the global bit buffer }
    bb:=b;
    bk:=k;
    { inflate that block type }
    IF (t=2) THEN
      BEGIN
        inflate_block:=inflate_dynamic;
        exit;
      END;
    if (t=0) THEN
      BEGIN
        inflate_block:=inflate_stored;
        exit;
      END;
    if (t=1) THEN
      BEGIN
        inflate_block:=inflate_fixed;
        exit;
      END;
    inflate_block:=2; { bad block }
  END;

  FUNCTION inflateblock:longint;
  { decompress an inflated entry }
  VAR
    e:int;      { last block flag }
    r:int;      { result code }
    h:unsigned; { maximum struct huft's malloc'ed }
    { initialize window, bit buffer }
  BEGIN
    new(slide);
    wp:=0;
    bk:=0;
    bb:=0;
    { decompress until the last block }
    h:=0;
    REPEAT
      hufts:=0;
      r:=inflate_block(@e);
      IF (r<>0) THEN
        BEGIN
          inflateblock:=r;
          exit;
        END;
      IF (hufts>h) THEN h:=hufts;
    UNTIL (e<>0);
    { flush out slide }
    flush_output(wp);
    { return success }
    dispose(slide);
    inflateblock:=0;
  END;

{--- LoadImagePNG ---}

CONST CPNGsig:TPNGSig=(137,80,78,71,13,10,26,10);
      Adam7_Xstart:array[1..7] of longint=(0,4,0,2,0,1,0);
      Adam7_Ystart:array[1..7] of longint=(0,0,4,0,2,0,1);
      Adam7_Xstep:array[1..7] of longint= (8,8,4,4,2,2,1);
      Adam7_Ystep:array[1..7] of longint= (8,8,8,4,4,2,2);

{      Adam7_Xd:array[1..7] of longint= (8,4,4,2,2,1,1);
      Adam7_Yd:array[1..7] of longint= (8,8,4,4,2,2,1); }

      Adam7_pnum:array[0..7] of longint= (4,5,7,8,11,12,14,15);

VAR PNGsig:TPNGsig;
    PNGchunk:TPNGchunk;
    PNGchunkCRC:longint;
    IHDR:IHDR_t;
    PLTE:PLTE_t;
    PNGbool:boolean;
    i:longint;
    colarray:array[0..2] of word;
    color:longint;
    startpos:longint;

    imageypos:pointer;
    linedata,linedataptr:pbyte;
    linedatasize:longint;
    priorbuf,linebuf:pbyte;
    sizescanline,sizepixel:longint;

    palette:array[0..255] of longint;

    pass{,curscanlinelength}:longint;
    xcount,ycount,xstep,ystep,pcnt,pmax:longint;

  FUNCTION getcurscanlinepixelcount_adam7:longint;
  BEGIN
    getcurscanlinepixelcount_adam7:=(IHDR.width-adam7_Xstart[pass]+adam7_Xstep[pass]-1) DIV adam7_Xstep[pass];
  END;

  FUNCTION getcurscanlinebytecount_adam7:longint;
  VAR i:longint;
  BEGIN
    i:=(IHDR.width-adam7_Xstart[pass]+adam7_Xstep[pass]-1) DIV adam7_Xstep[pass];
    CASE IHDR.colortype OF
    0:getcurscanlinebytecount_adam7:=((i*IHDR.bitdepth*1+7) SHR 3);
    2:getcurscanlinebytecount_adam7:=((i*IHDR.bitdepth*3+7) SHR 3);
    3:getcurscanlinebytecount_adam7:=((i*IHDR.bitdepth*1+7) SHR 3);
    4:getcurscanlinebytecount_adam7:=((i*IHDR.bitdepth*2+7) SHR 3);
    6:getcurscanlinebytecount_adam7:=((i*IHDR.bitdepth*4+7) SHR 3);
    END;
  END;

  PROCEDURE flush_output(w:longint);
  VAR x,xd,b,c,bitbuf,bitsinbuf:longint;
      fltbyt:byte;
      lp,rp,pp,dp:pbyte;
      ca,cb,cc,cp,pa,pb,pc:longint;

    FUNCTION getpixbits(var p:pbyte;n,swp:longint):longint;
    VAR i,b:byte;
    BEGIN
      WHILE (bitsinbuf<n) DO
        BEGIN
          b:=p^;
          CASE swp OF
          1:ASM
              XOR AX,AX
              MOV AH,b
              MOV CX,8
            @loop:
              SHR AX,1
              ROL AL,2
              LOOP @loop
              ROR AL,1
              MOV b,AL
            END;
          2:ASM
              XOR AX,AX
              MOV AH,b
              MOV CX,4
            @loop:
              SHR AX,2
              ROL AL,4
              LOOP @loop
              ROR AL,4
              MOV b,AL
            END;
          4:ASM
              ROR b,4
            END;
          END;
          bitbuf:=bitbuf OR longint(b) SHL bitsinbuf;
          inc(p);
          inc(bitsinbuf,8);
        END;
      getpixbits:=bitbuf AND ((longint(1) SHL n)-1);
      bitbuf:=bitbuf SHR n;
      dec(bitsinbuf,n);
    END;

{  VAR xx,yy:longint;}

  BEGIN
{DBG('flush',w);}
    rp:=pbyte(slide);
    WHILE (w>=linedatasize) DO
      BEGIN
        move(rp^,linedataptr^,linedatasize);
        inc(rp,linedatasize);
        dec(w,linedatasize);

        {LAACA}{ProgressMonitor(pcnt,pmax);}
        inc(pcnt);

        CASE IHDR.interlacetype OF
        0:BEGIN
            xd:=img^.width;
            linedatasize:=sizescanline+1;
          END;
        1:BEGIN
            xd:=getcurscanlinepixelcount_adam7;
            linedatasize:=getcurscanlinebytecount_adam7+1;
          END;
        END;

        linedataptr:=linedata;
        lp:=linedata;
        dp:=linebuf+sizepixel;
        pp:=priorbuf+sizepixel;
{DBG(fltbyt);}
        fltbyt:=lp^;
        inc(lp);
{DBG('fltbyt',fltbyt);}
        CASE fltbyt OF
        0:BEGIN {none}
            move(lp^,dp^,linedatasize-1);
        {    inc(dp,linedatasize-1);
            inc(lp,linedatasize-1); }
          END;
        1:BEGIN {sub}
            FOR b:=0 TO linedatasize-2 DO
              BEGIN
                dp^:=lp^+(dp-sizepixel)^;
                inc(dp);
                inc(lp);
              END;
          END;
        2:BEGIN {up}
            FOR b:=0 TO linedatasize-2 DO
              BEGIN
                dp^:=lp^+pp^;
                inc(dp);
                inc(pp);
                inc(lp);
              END;
          END;
        3:BEGIN {average}
            FOR b:=0 TO linedatasize-2 DO
              BEGIN
                dp^:=lp^+((dp-sizepixel)^+pp^) SHR 1;
                inc(dp);
                inc(pp);
                inc(lp);
              END;
          END;
        4:BEGIN {paeth}
            FOR b:=0 TO linedatasize-2 DO
              BEGIN
                ca:=(dp-sizepixel)^;
                cb:=pp^;
                cc:=(pp-sizepixel)^;
                cp:=ca+cb-cc;
                pa:=abs(cp-ca);
                pb:=abs(cp-cb);
                pc:=abs(cp-cc);
                IF (pa<=pb) AND (pa<=pc) THEN dp^:=lp^+ca
                                         ELSE IF (pb<=pc) THEN dp^:=lp^+cb
                                                          ELSE dp^:=lp^+cc;
                inc(dp);
                inc(pp);
                inc(lp);
              END;
          END;
        END;
        dp:=linebuf+sizepixel;
        bitbuf:=0;
        bitsinbuf:=0;
        IF (ycount<img^.height) THEN
        CASE IHDR.colortype OF
        0:FOR x:=0 TO xd-1 DO
            BEGIN
              c:=getpixbits(dp,IHDR.bitdepth,IHDR.bitdepth);
              c:=(c SHL (16-IHDR.bitdepth)) SHR 8;
              c:=MyRGB2word(c,c,c);
              move(c,(imageypos+x*xstep*bytperpix)^,bytperpix);
              inc(xcount,xstep);
            END;
        2:CASE IHDR.bitdepth OF
          8:FOR x:=0 TO xd-1 DO
              BEGIN
                c:=MyRGB2word((dp+0)^,(dp+1)^,(dp+2)^);
                inc(dp,3);
                move(c,(imageypos+x*xstep*bytperpix)^,bytperpix);

              {  FOR yy:=0 TO adam7_yd[pass]-1 DO
                  FOR xx:=0 TO adam7_xd[pass]-1 DO
                    IF (ycount+yy<img^.height) AND (x*xstep+xx<img^.width) THEN
                      move(c,(imageypos+(yy*img^.bytesperline)+(x*xstep+xx)*bytperpix)^,bytperpix); }

                inc(xcount,xstep);
              END;
         16:FOR x:=0 TO xd-1 DO
              BEGIN
                c:=MyRGB2word((dp+0)^,(dp+2)^,(dp+4)^);
                inc(dp,6);
                move(c,(imageypos+x*xstep*bytperpix)^,bytperpix);
                inc(xcount,xstep);
              END;
          END;
        3:FOR x:=0 TO xd-1 DO
            BEGIN
              c:=getpixbits(dp,IHDR.bitdepth,IHDR.bitdepth);
              move(palette[c],(imageypos+x*xstep*bytperpix)^,bytperpix);

  {            c:=-1;
              move(c,(imageypos+x*xstep*bytperpix)^,bytperpix); }

          {    FOR yy:=0 TO adam7_yd[pass]-1 DO
                FOR xx:=0 TO adam7_xd[pass]-1 DO
                  IF (ycount+yy<img^.height) AND (x*xstep+xx<img^.width) THEN
                    move(palette[c],(imageypos+(yy*img^.bytesperline)+(x*xstep+xx)*bytperpix)^,bytperpix); }

              inc(xcount,xstep);
            END;
        4:FOR x:=0 TO xd-1 DO
            BEGIN
              c:=MyRGB2word((dp+0)^,(dp+0)^,(dp+0)^);
              inc(dp,sizepixel);
              move(c,(imageypos+x*xstep*bytperpix)^,bytperpix);
              inc(xcount,xstep);
            END;
        6:CASE IHDR.bitdepth OF
          8:FOR x:=0 TO xd-1 DO
              BEGIN
                c:=MyRGB2word((dp+0)^,(dp+1)^,(dp+2)^);
                inc(dp,4);
                move(c,(imageypos+x*xstep*bytperpix)^,bytperpix);
                inc(xcount,xstep);
              END;
         16:FOR x:=0 TO xd-1 DO
              BEGIN
                c:=MyRGB2word((dp+0)^,(dp+2)^,(dp+4)^);
                inc(dp,8);
                move(c,(imageypos+x*xstep*bytperpix)^,bytperpix);
                inc(xcount,xstep);
              END;
          END;
        END;
        inc(imageypos,ystep*img^.bytesperline);
        inc(ycount,ystep);
        move(linebuf^,priorbuf^,sizepixel+linedatasize-1);
{putimage(0,0,img);}
{zoomimage(0,0,img^.width*8-1,img^.height*8-1,img);}
{readln;}
        IF (ycount>=img^.height) THEN
          BEGIN
            CASE IHDR.interlacetype OF
            1:BEGIN {adam7}
                WHILE (ycount>=img^.height) OR (xcount>=img^.width) DO
                  BEGIN
                    inc(pass);
                    xcount:=adam7_Xstart[pass];
                    ycount:=adam7_Ystart[pass];
                    xstep:=adam7_Xstep[pass];
                    ystep:=adam7_Ystep[pass];
                  END;
                linedatasize:=getcurscanlinebytecount_adam7+1;
                imageypos:=img^.pixeldata+ycount*img^.bytesperline+xcount*bytperpix;
              END;
            END;
            fillchar(linebuf^,sizescanline+sizepixel,0);
            fillchar(priorbuf^,sizescanline+sizepixel,0);
          END;
      END;
{DBG('END w',w);}
    move(rp^,linedataptr^,w);
    dec(linedatasize,w);
    inc(linedataptr,w);
  END;

var formatdat:byte;

BEGIN
  formatdat:=ZkontrolujFormat(stream);
  LoadImagePNG:=formatdat;
  if formatdat<>0 then Exit;
  startpos:=stream^.getpos;
  stream^.read(PNGsig,sizeof(PNGsig));
  PNGbool:=TRUE;
  FOR i:=0 TO 7 DO PNGbool:=PNGbool AND (PNGsig[i]=CPNGsig[i]);
  IF PNGbool THEN
    BEGIN
      REPEAT
        stream^.read(PNGchunk,sizeof(PNGchunk));
        swap32(PNGchunk.size);
{DBG(copy(PNGchunk.name,1,4));}
        IF cmp(PNGchunk.name,'IHDR') THEN
          BEGIN
            stream^.read(IHDR,PNGchunk.size);
            swap32(IHDR.width);
            swap32(IHDR.height);
{IHDR.interlacetype:=0;}
            CASE IHDR.colortype OF
            0:sizepixel:=((IHDR.bitdepth*1+7) SHR 3);
            2:sizepixel:=((IHDR.bitdepth*3+7) SHR 3);
            3:sizepixel:=((IHDR.bitdepth*1+7) SHR 3);
            4:sizepixel:=((IHDR.bitdepth*2+7) SHR 3);
            6:sizepixel:=((IHDR.bitdepth*4+7) SHR 3);
            END;
            CASE IHDR.colortype OF
            0:sizescanline:=((IHDR.width*IHDR.bitdepth*1+7) SHR 3);
            2:sizescanline:=((IHDR.width*IHDR.bitdepth*3+7) SHR 3);
            3:sizescanline:=((IHDR.width*IHDR.bitdepth*1+7) SHR 3);
            4:sizescanline:=((IHDR.width*IHDR.bitdepth*2+7) SHR 3);
            6:sizescanline:=((IHDR.width*IHDR.bitdepth*4+7) SHR 3);
            END;
            img:=CreateImageWH(IHDR.width,IHDR.height);
{DBG(IHDR.colortype);
DBG(IHDR.filtertype);
DBG(IHDR.compressiontype);
DBG(IHDR.interlacetype);
DBG(IHDR.width);
DBGw(IHDR.height);}
          END
        ELSE IF cmp(PNGchunk.name,'PLTE') THEN
          BEGIN
            stream^.read(PLTE,PNGchunk.size);
            FOR i:=0 TO 255 DO palette[i]:=MyRGB2word(PLTE[i,0],PLTE[i,1],PLTE[i,2]);
          END
        ELSE IF cmp(PNGchunk.name,'IDAT') THEN
          BEGIN
{DBG(pass);}
            stream^.read(i,2);
            IDATcount:=PNGchunk.size-2;
{DBG(sizescanline);
DBG(sizepixel);}
            getmem(linebuf,sizescanline+sizepixel);
            getmem(priorbuf,sizescanline+sizepixel);
            getmem(linedata,sizescanline+1);
            fillchar(linebuf^,sizescanline+sizepixel,0);
            fillchar(priorbuf^,sizescanline+sizepixel,0);
            linedataptr:=linedata;
            pass:=0;
{DBG('+++');
DBG(memavail);}
            CASE IHDR.interlacetype OF
            0:BEGIN { no interlace }
                xcount:=0;
                ycount:=0;
                xstep:=1;
                ystep:=1;
                linedatasize:=sizescanline+1;
                pmax:=img^.height-1;
              END;
            1:BEGIN {adam7}
                REPEAT
                  inc(pass);
                  xcount:=adam7_Xstart[pass];
                  ycount:=adam7_Ystart[pass];
                  xstep:=adam7_Xstep[pass];
                  ystep:=adam7_Ystep[pass];
                UNTIL (ycount<img^.height) AND (xcount<img^.width);
                linedatasize:=getcurscanlinebytecount_adam7+1;
                pmax:=(img^.height SHR 3)*15+adam7_pnum[img^.height AND NOT 7]-1;
              END;
            END;
            imageypos:=img^.pixeldata+ycount*img^.bytesperline+xcount*bytperpix;
{DBG('a');} pcnt:=0;
            CASE IHDR.compressiontype OF
            $00:inflateblock;
            END;
{DBGw('back');}
{DBG('b');}
{DBG(memavail);
DBG('---');}
{DBG(sizescanline);
DBG(sizepixel);}
{DBG('c1');}
            freemem(linebuf,sizescanline+sizepixel);
{DBG('c2');}
            freemem(priorbuf,sizescanline+sizepixel);
{DBG('c3');}
            freemem(linedata,sizescanline+1);
{DBG('c4');}
{DBG('d');}
            stream^.seek(stream^.getpos+IDATcount);
            LoadImagePNG:=0;
{DBG('e');}
          END
        ELSE IF cmp(PNGchunk.name,'IEND') THEN
          BEGIN
            stream^.seek(stream^.getpos+PNGchunk.size);
          END
        ELSE IF cmp(PNGchunk.name,'bKGD') THEN
          BEGIN
            CASE IHDR.colortype OF
            3:BEGIN
                colarray[0]:=0;
                stream^.read(colarray,PNGchunk.size);
                color:=palette[colarray[0]];
                {setimageflags(img,img_transparency);
                setimagetransparencycolor(img,color);}
 {   bar(600,440,639,479,color); }
              END;
          0,4:BEGIN
                stream^.read(colarray,PNGchunk.size);
                colarray[0]:=colarray[0] SHL (16-IHDR.bitdepth);
                color:=MyRGB2word(colarray[0] SHR 8,colarray[0] SHR 8,colarray[0] SHR 8);
                {setimageflags(img,img_transparency);
                setimagetransparencycolor(img,color);}
 {   bar(600,440,639,479,color); }
              END;
          2,6:BEGIN
                stream^.read(colarray,PNGchunk.size);
                colarray[0]:=colarray[0] SHL (16-IHDR.bitdepth);
                colarray[1]:=colarray[1] SHL (16-IHDR.bitdepth);
                colarray[2]:=colarray[2] SHL (16-IHDR.bitdepth);
                color:=MyRGB2word(colarray[0] SHR 8,colarray[1] SHR 8,colarray[2] SHR 8);
                {setimageflags(img,img_transparency);
                setimagetransparencycolor(img,color);}
{   bar(600,440,639,479,color); }
              END;
            ELSE stream^.seek(stream^.getpos+PNGchunk.size);
            END;
          END
        ELSE IF cmp(PNGchunk.name,'tRNS') THEN
          BEGIN
            CASE IHDR.colortype OF
            0:BEGIN
                stream^.read(colarray,PNGchunk.size);
                colarray[0]:=colarray[0] SHL (16-IHDR.bitdepth);
                color:=MyRGB2word(colarray[0] SHR 8,colarray[0] SHR 8,colarray[0] SHR 8);
                {setimageflags(img,img_transparency);
                setimagetransparencycolor(img,color);}
{    bar(600,440,639,479,color); }
              END;
            2:BEGIN
                stream^.read(colarray,PNGchunk.size);
                colarray[0]:=colarray[0] SHL (16-IHDR.bitdepth);
                colarray[1]:=colarray[1] SHL (16-IHDR.bitdepth);
                colarray[2]:=colarray[2] SHL (16-IHDR.bitdepth);
                color:=MyRGB2word(colarray[0] SHR 8,colarray[1] SHR 8,colarray[2] SHR 8);
                {setimageflags(img,img_transparency);
                setimagetransparencycolor(img,color);}
{   bar(600,440,639,479,color); }
              END;
            ELSE stream^.seek(stream^.getpos+PNGchunk.size);
            END;
          END
        ELSE
          BEGIN
            stream^.seek(stream^.getpos+PNGchunk.size);
          END;
        stream^.read(PNGchunkCRC,4);
      UNTIL cmp(PNGchunk.name,'IEND') OR (stream^.getpos>=stream^.getsize);
    END;
  stream^.seek(startpos);
END;


Function Load_PNG(s:string;var w:virtualwindow):byte;
{virtualwindow W will be initialized inside loader}
var i:PImage;
    h:PGrpStream;
    b:byte;
begin
w.VWoffset:=0;
h:=New(PGrpStream,Init(s,stOpenRead));
b:=LoadImagePNG(h,i,1);
if b=0 then
   begin
   Init_VW(w,i^.width,i^.height,false);
   FreeMem(pointer(w.VWoffset));
   w.VWoffset:=longint(i^.pixeldata);
   Dispose(i);
   end;
Load_PNG:=b;
Dispose(h,Done);
end;


Procedure Register_PNG_Loader;
begin
RegisterImageLoader('PNG',@Load_PNG);
end;


begin
Register_PNG_Loader;
end.
