--- /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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uBinPacker.pas Mon Jun 25 12:01:19 2012 +0200
@@ -0,0 +1,438 @@
+unit uBinPacker;
+
+interface
+
+// implements a maxrects packer with best short side fit heuristic
+
+type Rectangle = record
+ x, y, width, height: LongInt;
+ UserData: Pointer;
+end;
+
+type Size = record
+ width, height: LongInt;
+ UserData: Pointer;
+end;
+
+type PRectangle = ^Rectangle;
+type PSize = ^Size;
+
+type RectangleList = record
+ data: PRectangle;
+ count: LongInt;
+ size: LongInt;
+end;
+
+type SizeList = record
+ data: PSize;
+ count: LongInt;
+ size: LongInt;
+end;
+
+type Atlas = record
+ width, height: Longint;
+ freeRectangles: RectangleList;
+ usedRectangles: RectangleList;
+end;
+
+function atlasInsertAdaptive(var a: Atlas; sz: Size; var output: Rectangle): boolean;
+function atlasInsertSet(var a: Atlas; var input: SizeList; var outputs: RectangleList): boolean;
+function atlasNew(width, height: LongInt): Atlas;
+procedure atlasDelete(var a: Atlas);
+procedure atlasReset(var a: Atlas);
+
+procedure rectangleListInit(var list: RectangleList);
+procedure rectangleListRemoveAt(var list: RectangleList; index: LongInt);
+procedure rectangleListAdd(var list: RectangleList; r: Rectangle);
+procedure rectangleListClear(var list: RectangleList);
+procedure sizeListInit(var list: SizeList);
+procedure sizeListRemoveAt(var list: SizeList; index: LongInt);
+procedure sizeListAdd(var list: SizeList; s: Size); overload;
+procedure sizeListAdd(var list: SizeList; width, height: LongInt; UserData: Pointer); overload;
+procedure sizeListClear(var list: SizeList);
+
+implementation
+
+uses Math; // for min/max
+
+procedure rectangleListRemoveAt(var list: RectangleList; index: LongInt);
+var
+ i: Integer;
+begin
+ i:=index;
+ while (i + 1 < list.count) do
+ begin
+ list.data[i]:=list.data[i + 1];
+ inc(i);
+ end;
+ dec(list.count);
+end;
+
+procedure rectangleListAdd(var list: RectangleList; r: Rectangle);
+begin
+ if list.count >= list.size then
+ begin
+ inc(list.size, 512);
+ ReAllocMem(list.data, sizeof(Rectangle) * list.size);
+ end;
+ list.data[list.count]:=r;
+ inc(list.count);
+end;
+
+procedure rectangleListInit(var list: RectangleList);
+begin
+ list.data:= nil;
+ list.count:= 0;
+ list.size:= 0;
+end;
+
+procedure rectangleListClear(var list: RectangleList);
+begin
+ FreeMem(list.data);
+ list.count:= 0;
+ list.size:= 0;
+end;
+
+procedure sizeListRemoveAt(var list: SizeList; index: LongInt);
+begin
+ list.data[index]:= list.data[list.count - 1];
+ dec(list.count);
+end;
+
+procedure sizeListAdd(var list: SizeList; s: Size); overload;
+begin
+ if list.count >= list.size then
+ begin
+ inc(list.size, 512);
+ ReAllocMem(list.data, sizeof(Size) * list.size);
+ end;
+ list.data[list.count]:=s;
+ inc(list.count);
+end;
+
+procedure sizeListAdd(var list: SizeList; width, height: LongInt; UserData: Pointer); overload;
+var
+ sz: Size;
+begin
+ sz.width:= width;
+ sz.height:= height;
+ sz.UserData:= UserData;
+ sizeListAdd(list, sz);
+end;
+
+procedure sizeListInit(var list: SizeList);
+begin
+ list.data:= nil;
+ list.count:= 0;
+ list.size:= 0;
+end;
+
+procedure sizeListClear(var list: SizeList);
+begin
+ FreeMem(list.data);
+ list.count:= 0;
+ list.size:= 0;
+end;
+
+
+function isContainedIn(a, b: Rectangle): boolean;
+begin
+ isContainedIn:= (a.x >= b.x) and (a.y >= b.y)
+ and (a.x + a.width <= b.x + b.width)
+ and (a.y + a.height <= b.y + b.height);
+end;
+
+function findPositionForNewNodeBestShortSideFit(var list: RectangleList; width, height: LongInt;
+ var bestShortSideFit, bestLongSideFit: LongInt): Rectangle;
+var
+ bestNode: Rectangle;
+ i: Integer;
+ ri: Rectangle;
+ leftoverHoriz, leftoverVert, shortSideFit, longSideFit: Longint;
+begin
+ bestNode.x:= 0;
+ bestNode.y:= 0;
+ bestNode.width:= 0;
+ bestNode.height:= 0;
+ bestShortSideFit:= $7FFFFFFF;
+
+ for i:=0 to pred(list.count) do
+ begin
+ ri:= list.data[i];
+
+ // Try to place the rectangle in upright (non-flipped) orientation.
+ if (ri.width >= width) and (ri.height >= height) then
+ begin
+ leftoverHoriz:= Abs(ri.width - width);
+ leftoverVert:= Abs(ri.height - height);
+ shortSideFit:= Min(leftoverHoriz, leftoverVert);
+ longSideFit:= Max(leftoverHoriz, leftoverVert);
+
+ if (shortSideFit < bestShortSideFit) or
+ ((shortSideFit = bestShortSideFit) and (longSideFit < bestLongSideFit)) then
+ begin
+ bestNode.x:= ri.x;
+ bestNode.y:= ri.y;
+ bestNode.width:= width;
+ bestNode.height:= height;
+ bestShortSideFit:= shortSideFit;
+ bestLongSideFit:= longSideFit;
+ end;
+ end;
+
+ if (ri.width >= height) and (ri.height >= width) then
+ begin
+ leftoverHoriz:= Abs(ri.width - height);
+ leftoverVert:= Abs(ri.height - width);
+ shortSideFit:= Min(leftoverHoriz, leftoverVert);
+ longSideFit:= Max(leftoverHoriz, leftoverVert);
+
+ if (shortSideFit < bestShortSideFit) or
+ ((shortSideFit = bestShortSideFit) and (longSideFit < bestLongSideFit)) then
+ begin
+ bestNode.x:= ri.x;
+ bestNode.y:= ri.y;
+ bestNode.width:= height;
+ bestNode.height:= width;
+ bestShortSideFit:= shortSideFit;
+ bestLongSideFit:= longSideFit;
+ end;
+ end;
+ end;
+
+ findPositionForNewNodeBestShortSideFit:= bestNode;
+end;
+
+function scoreRect(var list: RectangleList; width, height: LongInt; var score1, score2: LongInt): Rectangle;
+var
+ newNode: Rectangle;
+begin
+ newNode:= findPositionForNewNodeBestShortSideFit(list, width, height, score1, score2);
+
+ // Cannot fit the current rectangle.
+ if newNode.height = 0 then
+ begin
+ score1:= $7FFFFFFF;
+ score2:= $7FFFFFFF;
+ end;
+
+ scoreRect:= newNode;
+end;
+
+function splitFreeNode(var freeRectangles: RectangleList; freeNode, usedNode: Rectangle): boolean;
+var
+ newNode: Rectangle;
+begin
+ // Test with SAT if the rectangles even intersect.
+ if (usedNode.x >= freeNode.x + freeNode.width) or (usedNode.x + usedNode.width <= freeNode.x) or
+ (usedNode.y >= freeNode.y + freeNode.height) or (usedNode.y + usedNode.height <= freeNode.y) then
+ begin
+ splitFreeNode:=false;
+ exit;
+ end;
+
+ if (usedNode.x < freeNode.x + freeNode.width) and (usedNode.x + usedNode.width > freeNode.x) then
+ begin
+ // New node at the top side of the used node.
+ if (usedNode.y > freeNode.y) and (usedNode.y < freeNode.y + freeNode.height) then
+ begin
+ newNode:= freeNode;
+ newNode.height:= usedNode.y - newNode.y;
+ rectangleListAdd(freeRectangles, newNode);
+ end;
+
+ // New node at the bottom side of the used node.
+ if (usedNode.y + usedNode.height < freeNode.y + freeNode.height) then
+ begin
+ newNode:= freeNode;
+ newNode.y:= usedNode.y + usedNode.height;
+ newNode.height:= freeNode.y + freeNode.height - (usedNode.y + usedNode.height);
+ rectangleListAdd(freeRectangles, newNode);
+ end;
+ end;
+
+ if (usedNode.y < freeNode.y + freeNode.height) and (usedNode.y + usedNode.height > freeNode.y) then
+ begin
+ // New node at the left side of the used node.
+ if (usedNode.x > freeNode.x) and (usedNode.y < freeNode.y + freeNode.width) then
+ begin
+ newNode:= freeNode;
+ newNode.width:= usedNode.x - newNode.x;
+ rectangleListAdd(freeRectangles, newNode);
+ end;
+
+ // New node at the right side of the used node.
+ if (usedNode.x + usedNode.width < freeNode.x + freeNode.width) then
+ begin
+ newNode:= freeNode;
+ newNode.x:= usedNode.x + usedNode.width;
+ newNode.width:= freeNode.x + freeNode.width - (usedNode.x + usedNode.width);
+ rectangleListAdd(freeRectangles, newNode);
+ end;
+ end;
+
+ splitFreeNode:= true;
+end;
+
+procedure pruneFreeList(var freeRectangles: RectangleList);
+var
+ i, j: LongInt;
+begin
+ // Go through each pair and remove any rectangle that is redundant.
+ i:= 0;
+ while i < freeRectangles.count do
+ begin
+ j:= i + 1;
+ while j < freeRectangles.count do
+ begin
+ if (isContainedIn(freeRectangles.data[i], freeRectangles.data[j])) then
+ begin
+ rectangleListRemoveAt(freeRectangles, i);
+ dec(i);
+ break;
+ end;
+
+ if (isContainedIn(freeRectangles.data[j], freeRectangles.data[i])) then
+ rectangleListRemoveAt(freeRectangles, j)
+ else
+ inc(j);
+ end;
+ inc(i);
+ end;
+end;
+
+function atlasInsertAdaptive(var a: Atlas; sz: Size; var output: Rectangle): boolean;
+var
+ newNode: Rectangle;
+ score1, score2: LongInt;
+ numRectanglesToProcess: LongInt;
+ i: LongInt;
+begin
+ newNode:= findPositionForNewNodeBestShortSideFit(a.freeRectangles, sz.width, sz.height, score1, score2);
+ if newNode.height = 0 then
+ begin
+ output:= newNode;
+ output.UserData:= nil;
+ atlasInsertAdaptive:= false;
+ exit;
+ end;
+
+ numRectanglesToProcess:= a.freeRectangles.count;
+
+ i:=0;
+ while i < numRectanglesToProcess do
+ begin
+ if splitFreeNode(a.freeRectangles, a.freeRectangles.data[i], newNode) then
+ begin
+ rectangleListRemoveAt(a.freeRectangles, i);
+ dec(numRectanglesToProcess);
+ end
+ else
+ inc(i);
+ end;
+
+ pruneFreeList(a.freeRectangles);
+ newNode.UserData:= sz.UserData;
+ rectangleListAdd(a.usedRectangles, newNode);
+ output:= newNode;
+ atlasInsertAdaptive:= true;
+end;
+
+procedure placeRect(var a: Atlas; node: Rectangle);
+var
+ numRectanglesToProcess: LongInt;
+ i: LongInt;
+begin
+ numRectanglesToProcess:= a.freeRectangles.Count;
+
+ i:= 0;
+ while i < numRectanglesToProcess do
+ begin
+ if not splitFreeNode(a.freeRectangles, a.freeRectangles.data[i], node) then
+ inc(i)
+ else
+ begin
+ rectangleListRemoveAt(a.freeRectangles, i);
+ dec(numRectanglesToProcess);
+ end;
+ end;
+
+ pruneFreeList(a.freeRectangles);
+ rectangleListAdd(a.usedRectangles, node);
+end;
+
+
+function atlasInsertSet(var a: Atlas; var input: SizeList; var outputs: RectangleList): boolean;
+var
+ bestScore1, bestScore2, bestRectIndex: LongInt;
+ score1, score2: LongInt;
+ bestNode, newNode: Rectangle;
+ i: LongInt;
+ sz: Size;
+begin
+ atlasInsertSet:= false;
+
+ while input.count > 0 do
+ begin
+ bestScore1:= $7FFFFFFF;
+ bestScore2:= $7FFFFFFF;
+ bestRectIndex:= -1;
+
+ for i:=0 to pred(input.count) do
+ begin
+ sz:= input.data[i];
+ newNode:= scoreRect(a.freeRectangles, sz.width, sz.height, score1, score2);
+
+ if (score1 >= bestScore1) and ((score1 <> bestScore1) or (score2 >= bestScore2)) then
+ continue;
+
+ bestScore1:= score1;
+ bestScore2:= score2;
+ bestNode:= newNode;
+ bestRectIndex:= i;
+ end;
+
+ if bestRectIndex = -1 then
+ exit;
+
+ bestNode.UserData:= input.data[bestRectIndex].UserData;
+ placeRect(a, bestNode);
+ rectangleListAdd(outputs, bestNode);
+ sizeListRemoveAt(input, bestRectIndex);
+ end;
+ atlasInsertSet:= true;
+end;
+
+function atlasNew(width, height: LongInt): Atlas;
+var
+ a: Atlas;
+ r: Rectangle;
+begin
+ rectangleListInit(a.freeRectangles);
+ rectangleListInit(a.usedRectangles);
+
+ a.width:= width;
+ a.height:= height;
+ r.x:= 0;
+ r.y:= 0;
+ r.width:= width;
+ r.height:= height;
+ rectangleListAdd(a.freeRectangles, r);
+
+ atlasNew:=a;
+end;
+
+procedure atlasDelete(var a: atlas);
+begin
+ rectangleListClear(a.freeRectangles);
+ rectangleListClear(a.usedRectangles);
+end;
+
+procedure atlasReset(var a: atlas);
+begin
+ atlasDelete(a);
+ a:=atlasNew(a.width, a.height);
+end;
+
+begin
+end.