diff -r ad4b6c2b09e8 -r 18430abfbcd2 hedgewars/uAtlas.pas
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uAtlas.pas	Mon Jun 25 12:01:19 2012 +0200
@@ -0,0 +1,701 @@
+{$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);
+
+implementation
+
+uses GLunit, uBinPacker, uDebug, png, sysutils;
+
+const
+    MaxAtlases = 1;    // Maximum number of atlases (textures) to allocate
+    MaxTexSize = 4096; // 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
+    end;
+
+var
+    Info: array[0..MaxAtlases-1] of AtlasInfo;
+
+
+////////////////////////////////////////////////////////////////////////////////
+// Debug routines
+
+var
+    DumpID: Integer;
+    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;
+var
+    p: Pbyte;
+    i: Integer;
+begin
+  //TStream(png_get_io_ptr(png)).Write(buffer^, size);
+    BlockWrite(DumpFile, buffer^, size);
+{    p:= PByte(buffer^);
+    for i:=0 to pred(size) do
+    begin
+        Write(DumpFile, p^);
+        inc(p);
+    end;}
+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;
+
+   IntToStrPad:=s;
+end;
+
+procedure DumpAtlas(var info: 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;
+    mem, p, pp: PByte;
+begin
+    filename:= '/home/wolfgangst/hedgewars/dump/atlas_' + IntToStrPad(DumpID) + '.png';
+    Assign(DumpFile, filename);
+    inc(DumpID);
+    Rewrite(DumpFile);
+
+    w:= info.TextureInfo.w;
+    h:= info.TextureInfo.h;
+    size:= w * h * 4;
+    SetLength(rows, h);
+    GetMem(mem, size);
+
+    glBindTexture(GL_TEXTURE_2D, info.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);
+
+    //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;
+    //randr:=Random;
+    //randg:=Random;
+    //randb:=1 - min(randr, randg);
+    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;
+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);
+end;
+
+{$DEFINE HAS_PBO}
+procedure Repack(var info: AtlasInfo; newAtlas: Atlas; newSprite: PTexture; surf: PSDL_Surface);
+var
+{$IFDEF HAS_PBO}
+    pbo: GLuint;
+{$ENDIF}
+    base: PByte;
+    oldSize: Integer;
+    oldWidth: Integer;
+    offset: Integer;
+    i,j : Integer;
+    r: Rectangle;
+    sp: PTexture;
+    newIsRotated: boolean;
+    newSpriteRect: Rectangle;
+begin
+    writeln('Repacking atlas (', info.PackerInfo.width, 'x', info.PackerInfo.height, ')', ' -> (', newAtlas.width, 'x', newAtlas.height, ')');
+
+{$IFDEF RETAIN_SURFACES}
+    // we can simply re-upload from RAM
+
+    // delete the old atlas
+    glDeleteTextures(1, @info.TextureInfo.id);
+
+    // create a new atlas with different size
+    info.TextureInfo:= createTexture(newAtlas.width, newAtlas.height);
+    glBindTexture(GL_TEXTURE_2D, info.TextureInfo.id);
+
+    atlasDelete(info.PackerInfo);
+    info.PackerInfo:= newAtlas;
+
+    // and process all sprites of the new atlas
+    for i:=0 to pred(newAtlas.usedRectangles.count) do
+    begin
+        r:= newAtlas.usedRectangles.data[i];
+        sp:= PTexture(r.UserData);
+        Upload(info, r, sp^.surface);
+    end;
+
+{$ELSE}
+    // as we dont have access to the original sprites in ram anymore,
+    // we need to copy from the existing atlas to an PBO, delete the original texture
+    // and finally copy from the PBO back to the new texture object
+
+    // allocate a PBO and copy from old atlas to it
+    oldSize:= info.TextureInfo.w * info.TextureInfo.h * 4;
+    oldWidth:= info.TextureInfo.w;
+
+    glBindTexture(GL_TEXTURE_2D, info.TextureInfo.id);
+
+{$IFDEF HAS_PBO}
+    base:= nil;
+    glGenBuffers(1, @pbo);
+    glBindBuffer(GL_PIXEL_PACK_BUFFER, pbo);
+    glBufferData(GL_PIXEL_PACK_BUFFER, oldSize, nil, GL_COPY);
+    //glGetTexImage( GL_TEXTURE_2D, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
+    
+    glBindBuffer(GL_PIXEL_PACK_BUFFER, 0);
+    glBindBuffer(GL_PIXEL_UNPACK_BUFFER, pbo);
+{$ELSE}
+    GetMem(base, oldSize);
+    glGetTexImage( GL_TEXTURE_2D, 0, GL_RGBA, GL_UNSIGNED_BYTE, base);
+{$ENDIF}
+
+    // delete the old atlas
+    glDeleteTextures(1, @info.TextureInfo.id);
+
+    // create a new atlas with different size
+    info.TextureInfo:= createTexture(newAtlas.width, newAtlas.height);
+    glBindTexture(GL_TEXTURE_2D, info.TextureInfo.id);
+    
+    
+    // and process all sprites of the new atlas
+    for i:=0 to pred(newAtlas.usedRectangles.count) do
+    begin
+        r:= newAtlas.usedRectangles.data[i];
+        sp:= PTexture(r.UserData);
+        if sp = newSprite then // this is the to be added sprite
+        begin
+            // we need to do defer the upload till after this loop, 
+            // as we currently upload from the PBO to texture
+            newSpriteRect:= r;
+            continue;
+        end;
+
+        newIsRotated:= sp^.w <> r.width;
+        if newIsRotated <> sp^.isRotated then
+        begin
+            glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
+            glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0);
+            glPixelStorei(GL_UNPACK_SKIP_ROWS, 0);
+            offset:= sp^.x + sp^.y * oldWidth;
+            for j:= 0 to pred(r.width) do
+            begin
+                glTexSubImage2D(GL_TEXTURE_2D, 0, r.x + j, r.y, 1, r.height, GL_RGBA, GL_UNSIGNED_BYTE, base + offset * 4);
+                inc(offset, oldWidth);
+            end;
+        end 
+        else
+        begin
+            glPixelStorei(GL_UNPACK_ROW_LENGTH, oldWidth);
+            glPixelStorei(GL_UNPACK_SKIP_PIXELS, sp^.x);
+            glPixelStorei(GL_UNPACK_SKIP_ROWS, sp^.y);
+            glTexSubImage2D(GL_TEXTURE_2D, 0, r.x, r.y, r.width, r.height, GL_RGBA, GL_UNSIGNED_BYTE, base);
+        end;
+
+        sp^.x:= r.x;
+        sp^.y:= r.y;
+        sp^.isRotated:= newIsRotated;
+        sp^.atlas:= @info.TextureInfo;
+    end;
+    glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
+    glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0);
+    glPixelStorei(GL_UNPACK_SKIP_ROWS, 0);
+
+    atlasDelete(info.PackerInfo);
+    info.PackerInfo:= newAtlas;
+
+{$IFDEF HAS_PBO}
+    glBindBuffer(GL_PIXEL_UNPACK_BUFFER, 0);
+    glDeleteBuffers(1, @pbo);
+{$ELSE}
+    FreeMem(base, oldSize);
+{$ENDIF}
+
+    // finally upload the new sprite (if any)
+    if newSprite <> nil then
+        Upload(info, newSpriteRect, surf);
+
+    glBindTexture(GL_TEXTURE_2D, 0);
+{$ENDIF}
+end;
+
+
+////////////////////////////////////////////////////////////////////////////////
+// Utility functions
+
+function SizeForSprite(sprite: PTexture): Size;
+begin
+    SizeForSprite.width:= sprite^.w;
+    SizeForSprite.height:= sprite^.h;
+    SizeForSprite.UserData:= sprite;
+end;
+
+procedure EnlargeSize(var x: Integer; var y: Integer);
+begin
+    if (y < x) then
+        y:= y + y
+    else
+        x:= x + x;
+end;
+
+procedure CompactSize(var x: Integer; var y: Integer);
+begin
+    if (x > y) then
+        x:= x div 2
+    else
+        y:= y div 2;
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+// Sprite allocation logic
+
+function TryRepack(var info: AtlasInfo; w, h: Integer; hasNewSprite: boolean; 
+                   newSprite: Size; surf: PSDL_Surface): boolean;
+var
+    sizes: SizeList;
+    repackedAtlas: Atlas;
+    sprite: PTexture;
+    i: Integer;
+    rects: RectangleList; // we wont really need this as we do a full repack using the atlas later on
+begin
+    TryRepack:= false;
+
+    // STEP 1: collect sizes of all existing sprites
+    sizeListInit(sizes);
+    for i:= 0 to pred(info.PackerInfo.usedRectangles.count) do
+    begin
+        sprite:= PTexture(info.PackerInfo.usedRectangles.data[i].UserData);
+        sizeListAdd(sizes, SizeForSprite(sprite));
+    end;
+
+    // STEP 2: add the new sprite to the list
+    if hasNewSprite then
+        sizeListAdd(sizes, newSprite);
+
+    // STEP 3: try to create a non adaptive re-packing using the whole list
+    repackedAtlas:= atlasNew(w, h);
+    rectangleListInit(rects);
+    if atlasInsertSet(repackedAtlas, sizes, rects) then
+    begin
+        TryRepack:= true;
+        if hasNewSprite then
+            sprite:= PTexture(newSprite.UserData)
+        else
+            sprite:= nil;
+        Repack(info, repackedAtlas, sprite, surf);
+        // repack assigns repackedAtlas to the current info and deletes the old one
+        // thus we wont do atlasDelete(repackedAtlas); here 
+        rectangleListClear(rects);
+        sizeListClear(sizes);
+        DumpAtlas(info);
+        exit;
+    end;
+
+    rectangleListClear(rects);
+    sizeListClear(sizes);
+    atlasDelete(repackedAtlas);
+end;
+
+function TryInsert(var info: AtlasInfo; newSprite: Size; surf: PSDL_Surface): boolean;
+var
+    rect: Rectangle;
+    sprite: PTexture;
+begin
+    TryInsert:= false;
+
+    if atlasInsertAdaptive(info.PackerInfo, newSprite, rect) then
+    begin
+        // we succeeded adaptivley allocating the sprite to the i'th atlas.
+        Upload(info, rect, surf);
+        DumpAtlas(info);
+        TryInsert:= true;
+    end;
+end;
+
+function Surface2Tex_(surf: PSDL_Surface; enableClamp: boolean): PTexture;
+var
+    sz: Size;
+    sprite: PTexture;
+    currentWidth, currentHeight: Integer;
+    i: Integer;
+begin
+    if (surf^.w > MaxTexSize) or (surf^.h > MaxTexSize) then
+    begin
+        // we could at best downscale the sprite, abort for now
+        writeln('Sprite size larger than maximum texture size');
+        halt(-1);        
+    end;
+
+    // allocate the sprite
+    new(sprite);
+    Surface2Tex_:= sprite;
+
+    sprite^.w:= surf^.w;
+    sprite^.h:= surf^.h;
+    sprite^.x:= 0;
+    sprite^.y:= 0;
+    sprite^.isRotated:= false;
+    sprite^.surface:= surf;
+
+    sz:= SizeForSprite(sprite);
+
+    // STEP 1
+    // try to allocate the new sprite in one of the existing atlases
+    for i:= 0 to pred(MaxAtlases) do
+    begin
+        if not Info[i].Allocated then
+            continue;
+        if TryInsert(Info[i], sz, surf) then
+            exit; 
+    end;
+
+
+    // STEP 2
+    // none of the atlases has space left for the allocation, try a garbage collection
+    for i:= 0 to pred(MaxAtlases) do
+    begin
+        if not Info[i].Allocated then
+            continue;
+
+        if TryRepack(Info[i], Info[i].PackerInfo.width, Info[i].PackerInfo.height, true, sz, surf) then
+            exit;
+    end;
+
+    // STEP 3
+    // none of the atlases could be repacked in a way to fit the new sprite, try enlarging
+    for i:= 0 to pred(MaxAtlases) do
+    begin
+        if not Info[i].Allocated then
+            continue;
+
+        currentWidth:= Info[i].PackerInfo.width;
+        currentHeight:= Info[i].PackerInfo.height;
+
+        EnlargeSize(currentWidth, currentHeight);
+        while (currentWidth <= MaxTexSize) and (currentHeight <= MaxTexSize) do
+        begin
+            if TryRepack(Info[i], currentWidth, currentHeight, true, sz, surf) then
+                exit;
+            EnlargeSize(currentWidth, currentHeight);
+        end;
+    end;
+
+    // STEP 4
+    // none of the existing atlases could be resized, try to allocate a new atlas
+    for i:= 0 to pred(MaxAtlases) do
+    begin
+        if Info[i].Allocated then
+            continue;
+
+        currentWidth:= MinTexSize;
+        currentHeight:= MinTexSize;
+        while (sz.width > currentWidth) do
+            currentWidth:= currentWidth + currentWidth;
+        while (sz.height > currentHeight) do
+            currentHeight:= currentHeight + currentHeight;
+
+        with Info[i] do
+        begin
+            PackerInfo:= atlasNew(currentWidth, currentHeight);
+            TextureInfo:= createTexture(currentWidth, currentHeight);
+            Allocated:= true;
+        end;
+
+        if TryInsert(Info[i], sz, surf) then
+            exit;
+
+        // this shouldnt have happened, the rectpacker should be able to fit the sprite
+        // into an unused rectangle that is the same size or larger than the requested sprite.
+        writeln('Internal error: atlas allocation failed');
+        halt(-1);
+    end;
+
+    // we reached the upperbound of resources we are willing to allocate
+    writeln('Exhausted maximum sprite allocation size');
+    halt(-1);
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+// Sprite deallocation logic
+
+
+procedure FreeTexture_(sprite: PTexture);
+var
+    i, j, deleteAt: Integer;
+    usedArea: Integer;
+    totalArea: Integer;
+    r: Rectangle;
+    atlasW, atlasH: Integer;
+    unused: Size;
+begin
+    if sprite = nil then
+        exit;
+
+    for i:= 0 to pred(MaxAtlases) do
+    begin
+        if sprite^.atlas <> @Info[i].TextureInfo then
+            continue;
+
+        usedArea:= 0;
+        for j:=0 to pred(Info[i].PackerInfo.usedRectangles.count) do
+        begin
+            r:= Info[i].PackerInfo.usedRectangles.data[j];
+            if r.UserData = sprite then
+                deleteAt:= j
+            else
+                inc(usedArea, r.width * r.height);
+        end;
+
+        rectangleListRemoveAt(Info[i].PackerInfo.usedRectangles, j);
+        dispose(sprite);
+
+        while true do
+        begin
+            atlasW:= Info[i].PackerInfo.width;
+            atlasH:= Info[i].PackerInfo.height;
+            totalArea:=  atlasW * atlasH;
+            if usedArea >= totalArea * CompressionThreshold then
+                exit;
+
+            if (atlasW = MinTexSize) and (atlasH = MinTexSize) then
+                exit; // we could try to move everything from this to another atlas here
+
+            CompactSize(atlasW, atlasH);
+            unused:= unused;
+            TryRepack(Info[i], atlasW, atlasH, false, unused, nil);
+        end;
+    end;
+end;
+
+procedure initModule;
+var
+    i: Integer;
+begin
+    DumpID:=0;
+    for i:= 0 to pred(MaxAtlases) do
+        Info[i].Allocated:= false;
+end;
+
+end.