{$INCLUDE "options.inc"}

{$IF GLunit = GL}{$DEFINE GLunit:=GL,GLext}{$ENDIF}

unit uAtlas;

interface

uses SDLh, uTypes;

procedure initModule;

function Surface2Tex_(surf: PSDL_Surface; enableClamp: boolean): PTexture;

procedure FreeTexture_(sprite: PTexture);

procedure DebugAtlas;

procedure DumpInfo(tex: PTexture);

implementation

uses GLunit, uBinPacker, uDebug, png, sysutils, uTextures;

const

    MaxAtlases = 4;    // Maximum number of atlases (textures) to allocate

    MaxTexSize = 1024; // Maximum atlas size in pixels

    MinTexSize = 128;  // Minimum atlas size in pixels

    CompressionThreshold = 0.4; // Try to compact (half the size of) an atlas, when occupancy is less than this

type

    AtlasInfo = record

        PackerInfo: Atlas;     // Rectangle packer context

        TextureInfo: TAtlas;   // OpenGL texture information

        Allocated: boolean;    // indicates if this atlas is in use

        DumpID: Integer;

    end;

var

    Info: array[0..MaxAtlases-1] of AtlasInfo;

////////////////////////////////////////////////////////////////////////////////

// Debug routines

procedure DumpInfo(tex: PTexture);

var

    frame: Integer;

    i, atlasID: Integer;

    aw, ah: Integer;

begin

    if tex = nil then

        exit;

    frame:= 0;

    writeln(stdout, 'Texture: ' + IntToHex(Integer(tex), 8));

    while tex <> nil do

    begin

        atlasID:= -1;

        for i:= 0 to Pred(MaxAtlases) do

            if tex^.atlas = @Info[i].TextureInfo then

                atlasID:=i;

        aw:= tex^.atlas^.w;

        ah:= tex^.atlas^.h;   

        writeln(stdout, 'Frame   : ' + IntToStr(frame));

        writeln(stdout, 'Size    : ' + IntToStr(tex^.w) + 'x' + IntToStr(tex^.h));

        writeln(stdout, 'Atlas   : ' + IntToStr(atlasID));

        writeln(stdout, 'Location: ' + IntToStr(tex^.x) + 'x' + IntToStr(tex^.y));

        writeln(stdout, 'TB      : ' + '(' + FloatToStrF(tex^.tb[0].X, ffFixed, 15, 4) + ',' + FloatToStrF(tex^.tb[0].Y, ffFixed, 15, 4) + ') '

                                     + '(' + FloatToStrF(tex^.tb[1].X, ffFixed, 15, 4) + ',' + FloatToStrF(tex^.tb[1].Y, ffFixed, 15, 4) + ') '

                                     + '(' + FloatToStrF(tex^.tb[2].X, ffFixed, 15, 4) + ',' + FloatToStrF(tex^.tb[2].Y, ffFixed, 15, 4) + ') '

                                     + '(' + FloatToStrF(tex^.tb[3].X, ffFixed, 15, 4) + ',' + FloatToStrF(tex^.tb[3].Y, ffFixed, 15, 4) + ')');

        writeln(stdout, 'TB.ABS  : ' + '(' + FloatToStrF(tex^.tb[0].X * aw, ffFixed, 15, 4) + ',' + FloatToStrF(tex^.tb[0].Y * ah, ffFixed, 15, 4) + ') '

                                     + '(' + FloatToStrF(tex^.tb[1].X * aw, ffFixed, 15, 4) + ',' + FloatToStrF(tex^.tb[1].Y * ah, ffFixed, 15, 4) + ') '

                                     + '(' + FloatToStrF(tex^.tb[2].X * aw, ffFixed, 15, 4) + ',' + FloatToStrF(tex^.tb[2].Y * ah, ffFixed, 15, 4) + ') '

                                     + '(' + FloatToStrF(tex^.tb[3].X * aw, ffFixed, 15, 4) + ',' + FloatToStrF(tex^.tb[3].Y * ah, ffFixed, 15, 4) + ')');

        inc(frame);

        tex:= tex^.nextFrame;

    end;

    halt(0);

end;

procedure AssertCount(tex: PTexture; count: Integer);

var

    i, j: Integer;

    found: Integer;

begin

    found:= 0;

    for i:= 0 to pred(MaxAtlases) do

    begin

        if not Info[i].Allocated then

            continue;

        for j:=0 to pred(Info[i].PackerInfo.usedRectangles.count) do

        begin

            if Info[i].PackerInfo.usedRectangles.data[j].UserData = tex then

                inc(found);

        end;

    end;

    if found <> count then

    begin

        writeln('AssertCount(', IntToHex(Integer(tex), 8), ') failed, found ', found, ' times');

        for i:= 0 to pred(MaxAtlases) do

        begin

            if not Info[i].Allocated then

                continue;

            for j:=0 to pred(Info[i].PackerInfo.usedRectangles.count) do

            begin

                if Info[i].PackerInfo.usedRectangles.data[j].UserData = tex then

                    writeln(' found in atlas ', i, ' at slot ', j);

            end;

        end;

        halt(-2);

    end;

end;

var

    DumpFile: File of byte;

const

    PNG_COLOR_TYPE_RGBA = 6;

    PNG_COLOR_TYPE_RGB = 2;

    PNG_INTERLACE_NONE = 0;

    PNG_COMPRESSION_TYPE_DEFAULT = 0;

    PNG_FILTER_TYPE_DEFAULT = 0;

procedure writefunc(png: png_structp; buffer: png_bytep; size: QWord); cdecl;

begin

    BlockWrite(DumpFile, buffer^, size);

end;

function IntToStrPad(i: Integer): string;

var

  s: string;

begin

   s:= IntToStr(i);

   if (i < 10) then s:='0' + s;

   if (i < 100) then s:='0' + s;

   if (i < 1000) then s:='0' + s;

   IntToStrPad:=s;

end;

// GL1 ATLAS DEBUG ONLY CODE!

procedure DebugAtlas;

{$IFDEF DEBUG_ATLAS}

var

    vp: array[0..3] of GLint;

    prog: GLint;

    i: Integer;

    x, y: Integer;

const

    SZ = 512;

begin

    x:= 0;

    y:= 0;

    for i:= 0 to pred(MaxAtlases) do

    begin

        if not Info[i].allocated then

            continue;

        glGetIntegerv(GL_VIEWPORT, @vp);

{$IFDEF GL2}

        glGetIntegerv(GL_CURRENT_PROGRAM, @prog);

        glUseProgram(0);

{$ENDIF}

        glPushMatrix;

        glLoadIdentity;

        glMatrixMode(GL_PROJECTION);

        glPushMatrix;

        glLoadIdentity;

        glOrtho(0, vp[2], vp[3], 0, -1, 1);

        glDisable(GL_CULL_FACE);

        glBindTexture(GL_TEXTURE_2D, Info[i].TextureInfo.id);

        glBegin(GL_QUADS);

        glTexCoord2f(0.0, 0.0);

        glVertex2i(x * SZ, y * SZ);

        glTexCoord2f(1.0, 0.0);

        glVertex2i((x + 1) * SZ, y * SZ);

        glTexCoord2f(1.0, 1.0);

        glVertex2i((x + 1) * SZ, (y + 1) * SZ);

        glTexCoord2f(0.0, 1.0);

        glVertex2i(x * SZ, (y + 1) * SZ);

        glEnd();

        glPopMatrix;

        glMatrixMode(GL_MODELVIEW);

        glPopMatrix;

        inc(x);

        if (x = 2) then

        begin

            x:=0;

            inc(y);

        end;

{$IFDEF GL2}

        glUseProgram(prog);

{$ENDIF}

    end;

end;

{$ELSE}

begin;

end;

{$ENDIF}

procedure DumpAtlas(var dinfo: AtlasInfo);

var

    png: png_structp;

    png_info: png_infop;

    w, h, sz: Integer;

    filename: string;

    rows: array of png_bytep;

    size: Integer;

    i, j: Integer;

    idx: Integer;

    mem, p, pp: PByte;

begin

    idx:= -1;

    for i:= 0 to Pred(MaxAtlases) do

        if @dinfo = @Info[i] then

            idx:=i;

    filename:= '/home/wolfgangst/hedgewars/dump/atlas_' + IntToStr(idx) + '_' + IntToStrPad(dinfo.DumpID) + '.png';

    Assign(DumpFile, filename);

    inc(dinfo.DumpID);

    Rewrite(DumpFile);

    w:= dinfo.TextureInfo.w;

    h:= dinfo.TextureInfo.h;

    size:= w * h * 4;

    SetLength(rows, h);

    GetMem(mem, size);

    glBindTexture(GL_TEXTURE_2D, dinfo.TextureInfo.id);

    glGetTexImage(GL_TEXTURE_2D, 0, GL_RGBA, GL_UNSIGNED_BYTE, mem);

    p:= mem;

    for i:= 0 to pred(h) do

    begin

        rows[i]:= p;

        pp:= p;

        inc(pp, 3);

        {for j:= 0 to pred(w) do

        begin

            pp^:=255;

            inc(pp, 4);

        end;}

        inc(p, w * 4);

    end;

    png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

    png_info := png_create_info_struct(png);

    png_set_write_fn(png, nil, @writefunc, nil);

    png_set_IHDR(png, png_info, w, h, 8, PNG_COLOR_TYPE_RGBA, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);

    png_write_info(png, png_info);

    png_write_image(png, @rows[0]);

    png_write_end(png, png_info);

    png_destroy_write_struct(@png, @png_info);

    FreeMem(mem);

    SetLength(rows, 0);

    Close(DumpFile);

    //if (DumpID >= 30) then

    //    halt(0);

end;

////////////////////////////////////////////////////////////////////////////////

// Upload routines

function createTexture(width, height: Integer): TAtlas;

var

  nullTex: Pointer;

begin

    createTexture.w:= width;

    createTexture.h:= height;

    createTexture.priority:= 0;

    glGenTextures(1, @createTexture.id);

    glBindTexture(GL_TEXTURE_2D, createTexture.id);

    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

    //glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);

    GetMem(NullTex, width * height * 4);

    FillChar(NullTex^, width * height * 4, 0);

    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, NullTex);

    FreeMem(NullTex);

    glBindTexture(GL_TEXTURE_2D, 0);

end;

function Min(x, y: Single): Single;

begin

  if x < y then

    Min:=x

  else Min:=y;

end;

function Max(x, y: Single): Single;

begin

  if x > y then

    Max:=x

  else Max:=y;

end;

procedure HSVToRGB(const H, S, V: Single; out R, G, B: Single); 

const 

    SectionSize = 60/360; 

var 

    Section: Single; 

    SectionIndex: Integer; 

    f: single; 

    p, q, t: Single; 

begin

    if H < 0 then 

    begin 

        R:= V; 

        G:= R; 

        B:= R; 

    end 

    else 

    begin 

        Section:= H/SectionSize; 

        SectionIndex:= Trunc(Section); 

        f:= Section - SectionIndex; 

        p:= V * ( 1 - S ); 

        q:= V * ( 1 - S * f ); 

        t:= V * ( 1 - S * ( 1 - f ) ); 

        case SectionIndex of 

            0: 

            begin 

                R:= V; 

                G:= t; 

                B:= p; 

            end; 

            1: 

            begin 

                R:= q; 

                G:= V; 

                B:= p; 

            end; 

            2: 

            begin 

                R:= p; 

                G:= V; 

                B:= t; 

            end; 

            3: 

            begin 

                R:= p; 

                G:= q; 

                B:= V; 

            end; 

            4: 

            begin 

                R:= t; 

                G:= p; 

                B:= V; 

            end; 

            else 

                R:= V; 

                G:= p; 

                B:= q; 

        end; 

    end; 

end; 

procedure DebugColorize(surf: PSDL_Surface);

var

    sz: Integer;

    p: PByte;

    i: Integer;

    r, g, b, a, inva: Integer;

    randr, randg, randb: Single;

    randh: Single;

begin

    sz:= surf^.w * surf^.h;

    p:= surf^.pixels;

    randh:=Random;

    HSVToRGB(randh, 1.0, 1.0, randr, randg, randb);

    for i:=0 to pred(sz) do

    begin

        a:= p[3];

        inva:= 255 - a;

        r:=Trunc(inva*randr + p[0]*a/255);

        g:=Trunc(inva*randg + p[1]*a/255);

        b:=Trunc(inva*randb + p[2]*a/255);

        if r > 255 then r:= 255;

        if g > 255 then g:= 255;

        if b > 255 then b:= 255;

        p[0]:=r;

        p[1]:=g;

        p[2]:=b;

        p[3]:=255;

        inc(p, 4);

    end;

end;

procedure Upload(var info: AtlasInfo; sprite: Rectangle; surf: PSDL_Surface);

var

    sp: PTexture;

    i, j, stride: Integer;

    scanline: PByte;

    r: TSDL_Rect;

begin

    //writeln('Uploading sprite to ', sprite.x, ',', sprite.y, ',', sprite.width, ',', sprite.height);

    sp:= PTexture(sprite.UserData);

    sp^.x:= sprite.x;

    sp^.y:= sprite.y;

    sp^.isRotated:= sp^.w <> sprite.width;

    sp^.atlas:= @info.TextureInfo;

    if SDL_MustLock(surf) then

        SDLTry(SDL_LockSurface(surf) >= 0, true);

    //if GrayScale then

    //    Surface2GrayScale(surf);

    //DebugColorize(surf);

    glBindTexture(GL_TEXTURE_2D, info.TextureInfo.id);

    if (sp^.isRotated) then

    begin

        scanline:= surf^.pixels;

        for i:= 0 to pred(sprite.width) do

        begin

            glTexSubImage2D(GL_TEXTURE_2D, 0, sprite.x + i, sprite.y, 1, sprite.height, GL_RGBA, GL_UNSIGNED_BYTE, scanline);

            inc(scanline, sprite.height * 4);

        end;

    end

    else

        glTexSubImage2D(GL_TEXTURE_2D, 0, sprite.x, sprite.y, sprite.width, sprite.height, GL_RGBA, GL_UNSIGNED_BYTE, surf^.pixels);

    glBindTexture(GL_TEXTURE_2D, 0);

    if SDL_MustLock(surf) then

        SDL_UnlockSurface(surf);

    r.x:= 0;

    r.y:= 0;

    r.w:= sp^.w;

    r.h:= sp^.h;

    ComputeTexcoords(sp, @r, @sp^.tb);

end;

procedure Repack(var info: AtlasInfo; newAtlas: Atlas);

var

    base: PByte;

    oldSize: Integer;

    oldWidth: Integer;

    offset: Integer;

    i,j : Integer;

    r: Rectangle;

    sp: PTexture;