- Added ref counting to TMaterial

- Added cache growing to TCacheManager
- Fixed ImagingOptions.inc to not include JPEG support
- Fixed TfrmRadar to save the radar map to the correct location
- Fixed statics using the wrong hue when being painted
- Removed obsolete TLandTextureManager.GetFlatLandMaterial (and the according cache)

Client/ULandscape.pas

@@ -43,11 +43,13 @@ type
   PRadarBlock = ^TRadarBlock;
   TRadarBlock = array[0..7, 0..7] of Word;
   
-  { TMaterial }             //TODO : add ref counting
+  { TMaterial }
   
-  TMaterial = class
+  TMaterial = class(ICacheable)
+    constructor Create;
     destructor Destroy; override;
   protected
+    FRefCount: Integer;
     FWidth: Integer;
     FHeight: Integer;
     FRealWidth: Integer;
@@ -64,7 +66,13 @@ type
     property RealHeight: Integer read FRealHeight;
     property Texture: GLuint read GetTexture;
 
+    procedure AddRef;
+    procedure DelRef;
     function HitTest(AX, AY: Integer): Boolean;
+
+    {ICacheable}
+    function CanBeRemoved: Boolean;
+    procedure RemoveFromCache;
   end;
 
   { TSimpleMaterial }
@@ -100,7 +108,6 @@ type
     destructor Destroy; override;
   protected
     FArtCache: TMaterialCache;
-    FFlatLandArtCache: TMaterialCache;
     FTexCache: TMaterialCache;
     FAnimCache: TMaterialCache;
     FUseAnims: Boolean;
@@ -109,7 +116,6 @@ type
     function GetArtMaterial(ATileID: Word): TMaterial; overload;
     function GetArtMaterial(ATileID: Word; AHue: THue;
       APartialHue: Boolean): TMaterial; overload;
-    function GetFlatLandMaterial(ATileID: Word): TMaterial;
     function GetStaticMaterial(AStaticItem: TStaticItem;
       AOverrideHue: Integer = -1): TMaterial;
     function GetTexMaterial(ATileID: Word): TMaterial;
@@ -309,7 +315,6 @@ constructor TLandTextureManager.Create;
 begin
   inherited Create;
   FArtCache := TMaterialCache.Create(1024);
-  FFlatLandArtCache := TMaterialCache.Create(128);
   FTexCache := TMaterialCache.Create(128);
   FAnimCache := TMaterialCache.Create(128);
   FUseAnims := True;
@@ -318,7 +323,6 @@ end;
 destructor TLandTextureManager.Destroy;
 begin
   FreeAndNil(FArtCache);
-  FreeAndNil(FFlatLandArtCache);
   FreeAndNil(FTexCache);
   FreeAndNil(FAnimCache);
   inherited Destroy;
@@ -351,6 +355,8 @@ begin
 
     artEntry.Free;
   end;
+
+  Result.AddRef;
 end;
 
 function TLandTextureManager.GetArtMaterial(ATileID: Word; AHue: THue;
@@ -388,21 +394,7 @@ begin
 
       artEntry.Free;
     end;
-  end;
+    Result.AddRef;
-end;
-
-function TLandTextureManager.GetFlatLandMaterial(ATileID: Word): TMaterial;
-var
-  artEntry: TArt;
-begin
-  if not FFlatLandArtCache.QueryID(ATileID, Result) then
-  begin
-    artEntry := ResMan.Art.GetFlatLand(ATileID);
-
-    Result := TSimpleMaterial.Create(artEntry.Graphic);
-    FFlatLandArtCache.StoreID(ATileID, Result);
-
-    artEntry.Free;
   end;
 end;
 
@@ -417,7 +409,7 @@ begin
     AOverrideHue := AStaticItem.Hue;
 
   if AOverrideHue > 0 then
-    hue := ResMan.Hue.Hues[AOverrideHue]
+    hue := ResMan.Hue.Hues[AOverrideHue - 1]
   else
     hue := nil;
 
@@ -444,6 +436,9 @@ begin
     end else
       Result := nil;
   end;
+
+  if Result <> nil then
+    Result.AddRef;
 end;
 
 { TSeperatedStaticBlock }
@@ -1197,6 +1192,11 @@ end;
 
 { TMaterial }
 
+constructor TMaterial.Create;
+begin
+  FRefCount := 1;
+end;
+
 destructor TMaterial.Destroy;
 begin
   FreeAndNil(FGraphic);
@@ -1234,6 +1234,18 @@ begin
   glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
 end;
 
+procedure TMaterial.AddRef;
+begin
+  Inc(FRefCount);
+end;
+
+procedure TMaterial.DelRef;
+begin
+  Dec(FRefCount);
+  if FRefCount < 1 then
+    Free;
+end;
+
 function TMaterial.HitTest(AX, AY: Integer): Boolean;
 var
   pixel: TColor32Rec;
@@ -1248,6 +1260,16 @@ begin
   end;
 end;
 
+function TMaterial.CanBeRemoved: Boolean;
+begin
+  Result := FRefCount <= 1;
+end;
+
+procedure TMaterial.RemoveFromCache;
+begin
+  DelRef;
+end;
+
 { TScreenBuffer }
 
 constructor TScreenBuffer.Create;
@@ -1303,6 +1325,8 @@ begin
     current^.Item.Locked := False;
     current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);
     if current^.Normals <> nil then Dispose(current^.Normals);
+    if current^.HighRes <> nil then current^.HighRes.DelRef;
+    if current^.LowRes <> nil then current^.LowRes.DelRef;
     current^.Text.Free;
     Dispose(current);
     current := next;
@@ -1331,6 +1355,8 @@ begin
       if last <> nil then last^.Next := current^.Next;
 
       if current^.Normals <> nil then Dispose(current^.Normals);
+      if current^.HighRes <> nil then current^.HighRes.DelRef;
+      if current^.LowRes <> nil then current^.LowRes.DelRef;
       current^.Text.Free;
 
       Dispose(current);
@@ -1616,6 +1642,8 @@ var
   art: array of TArt;
   caps: TGLTextureCaps;
 begin
+  inherited Create;
+
   FAnimData := AAnimData;
 
   FRealWidth := 0;

Client/UfrmMain.pas

@@ -1000,7 +1000,8 @@ end;
 procedure TfrmMain.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
 begin
   if (FScreenBufferState <> CScreenBufferValid) or
-     ({FRepaintNeeded and }(MilliSecondsBetween(Now, FLastDraw) > 50)) then
+     ((FRepaintNeeded or mnuShowAnimations.Checked) and
+      (MilliSecondsBetween(Now, FLastDraw) > 50)) then
   begin
     //Logger.Send([lcClient, lcDebug], 'Repainting Game Window');
     oglGameWindow.Repaint;
@@ -1895,11 +1896,9 @@ procedure TfrmMain.InitSize;
 begin
   glViewport(0, 0, oglGameWindow.Width, oglGameWindow.Height);
   glMatrixMode(GL_PROJECTION);
-  glPushMatrix;
   glLoadIdentity;
   gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0);
   glMatrixMode(GL_MODELVIEW);
-  glPushMatrix;
   glLoadIdentity;
 end;
 
@@ -1999,6 +1998,9 @@ begin
     rawZ := item.RawZ;
   end;
 
+  if ABlockInfo^.HighRes <> nil then ABlockInfo^.HighRes.DelRef;
+  if ABlockInfo^.LowRes <> nil then ABlockInfo^.LowRes.DelRef;
+
   ABlockInfo^.HighRes := nil;
   ABlockInfo^.CheckRealQuad := False;
   ABlockInfo^.Text.Free;
@@ -2181,7 +2183,6 @@ begin
       if not highlight then
         glEnable(GL_LIGHTING);
 
-      glLoadName(PtrInt(item));
       glBegin(GL_QUADS);
         glNormal3fv(@blockInfo^.Normals^[0]);
         glTexCoord2i(0, 0); glVertex2iv(@blockInfo^.DrawQuad[0]);
@@ -2198,7 +2199,6 @@ begin
     end else
     begin
       glBindTexture(GL_TEXTURE_2D, blockInfo^.LowRes.Texture);
-      glLoadName(PtrInt(item));
       glBegin(GL_QUADS);
         glTexCoord2i(0, 0); glVertex2iv(@blockInfo^.DrawQuad[0]);
         glTexCoord2i(1, 0); glVertex2iv(@blockInfo^.DrawQuad[1]);

Client/UfrmRadar.lfm

@@ -30,7 +30,7 @@ object frmRadarMap: TfrmRadarMap
       Left = 8
       Height = 21
       Top = 0
-      Width = 39
+      Width = 41
       Align = alLeft
       BorderSpacing.Left = 8
       Layout = tlCenter

Client/UfrmRadar.pas

@@ -115,8 +115,8 @@ begin
     for y := 0 to FRadar.Height - 1 do
       radarMap[x * FRadar.Height + y] := EncodeUOColor(PInteger(FRadar.PixelPointers[x, y])^);
 
-  radarMapFile := TFileStream.Create(IncludeTrailingPathDelimiter(
+  radarMapFile := TFileStream.Create(GetAppConfigDir(False) + 'RadarMap.cache',
-    ExtractFilePath(Application.ExeName)) + 'RadarMap.cache', fmCreate);
+    fmCreate);
   radarMapFile.Write(radarMap[0], Length(radarMap) * SizeOf(Word));
   radarMapFile.Free;
 

Imaging/ImagingOptions.inc

@@ -27,10 +27,10 @@
   Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line
 *)
 
-//{$DEFINE DONT_LINK_JPEG}        // link support for Jpeg images
+{$DEFINE DONT_LINK_JPEG}        // link support for Jpeg images
-//{$DEFINE DONT_LINK_PNG}         // link support for PNG images
+{.$DEFINE DONT_LINK_PNG}         // link support for PNG images
-//{$DEFINE DONT_LINK_TARGA}       // link support for Targa images
+{.$DEFINE DONT_LINK_TARGA}       // link support for Targa images
-//{$DEFINE DONT_LINK_BITMAP}      // link support for Windows Bitmap images
+{.$DEFINE DONT_LINK_BITMAP}      // link support for Windows Bitmap images
 {$DEFINE DONT_LINK_DDS}         // link support for DDS images
 {$DEFINE DONT_LINK_GIF}         // link support for GIF images
 {$DEFINE DONT_LINK_MNG}         // link support for MNG images

UCacheManager.pas

@@ -26,6 +26,7 @@
 unit UCacheManager;
 
 {$mode objfpc}{$H+}
+{$interfaces corba}
 
 interface
 
@@ -34,6 +35,11 @@ uses
 
 type
 
+  ICacheable = interface['{0ABAA4DE-8128-47B3-ABFE-5250A74A0428}']
+    function CanBeRemoved: Boolean;
+    procedure RemoveFromCache;
+  end;
+
   { TCacheManager }
 
   generic TCacheManager<T> = class
@@ -53,6 +59,7 @@ type
     FFirst: PCacheEntry;
     FLast: PCacheEntry;
     FOnRemoveObject: TRemoveObjectEvent;
+    procedure DoRemoveObject(var AObject: T; ANotify: Boolean = True);
   public
     constructor Create(ASize: Integer);
     destructor Destroy; override;
@@ -73,8 +80,24 @@ type
 
 implementation
 
+uses
+  Logging;
+
 { TCacheManager }
 
+procedure TCacheManager.DoRemoveObject(var AObject: T; ANotify: Boolean = True);
+var
+  cacheable: ICacheable;
+begin
+  if ANotify and Assigned(FOnRemoveObject) then FOnRemoveObject(AObject);
+
+  if TObject(AObject).GetInterface(ICacheable, cacheable) then
+    cacheable.RemoveFromCache
+  else
+    TObject(AObject).Free;
+  TObject(AObject) := nil;
+end;
+
 constructor TCacheManager.Create(ASize: Integer);
 var
   i: Integer;
@@ -109,10 +132,7 @@ begin
   for i := 1 to FSize do
   begin
     if Pointer(current^.Obj) <> nil then
-    begin
+      DoRemoveObject(current^.Obj);
-      if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
-      FreeAndNil(current^.Obj);
-    end;
     last := current;
     current := current^.Next;
     Dispose(last);
@@ -166,7 +186,7 @@ begin
     begin
       current^.ID := LongInt($FFFFFFFF);
       if Pointer(current^.Obj) <> nil then
-        FreeAndNil(current^.Obj);
+        DoRemoveObject(current^.Obj, False);
     end;
     if (current^.Next <> nil) then
       FLast := current;
@@ -184,8 +204,7 @@ begin
     if Pointer(current^.Obj) <> nil then
     begin
       current^.ID := LongInt($FFFFFFFF);
-      if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
+      DoRemoveObject(current^.Obj);
-      FreeAndNil(current^.Obj);
     end;
     current := current^.Next;
   end;
@@ -230,17 +249,37 @@ end;
 procedure TCacheManager.StoreID(AID: Integer; AObj: T);
 var
   current: PCacheEntry;
+  cacheable: ICacheable;
+  i: Integer;
 begin
   current := FLast^.Next; //well, FLast is not really the last, but the one before the last ;)
   FLast^.Next := nil;
   current^.Next := FFirst;
   FFirst := current;
-  FFirst^.ID := AID;
+  if Pointer(FFirst^.Obj) <> nil then //if the last cache entry did contain an object, remove it now or grow
-  if Pointer(FFirst^.Obj) <> nil then //if the last cache entry did contain an object, remove it now
   begin
-    if Assigned(FOnRemoveObject) then FOnRemoveObject(FFirst^.Obj);
+    if TObject(FFirst^.Obj).GetInterface(ICacheable, cacheable) and
-    FreeAndNil(FFirst^.Obj);
+      not cacheable.CanBeRemoved then
+    begin
+      Logger.Send([lcInfo], 'Cache growing (%s)', [ClassName]);
+      New(FLast^.Next);
+      current := FLast^.Next;
+      current^.ID := FFirst^.ID;
+      current^.Obj := FFirst^.Obj;
+      for i := 2 to FSize do
+      begin
+        New(current^.Next);
+        FLast := current;
+        current := current^.Next;
+        current^.ID := LongInt($FFFFFFFF);
+        current^.Obj := nil;
+      end;
+      current^.Next := nil;
+      FSize := FSize * 2;
+    end else
+      DoRemoveObject(current^.Obj);
   end;
+  FFirst^.ID := AID;
   FFirst^.Obj := AObj;
 end;