{$MODE FPC}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}
unit resource_texture;

interface

uses
  dresourcemanager;

type
TTexturePatameters = object
  FileName: AnsiString;
  Flags: Cardinal;
end;

PTextureType = ^TTextureType;
TTextureType = object(TResourceType)
public
  function GetSingleton: PTextureType; static; inline;
  function OnAllocHolder(ResourceRecord: PResourceRecord;
                         Parameters: Pointer;
                         out Holder: Pointer): Boolean; virtual;
  function OnAllocDefaultHolder(ResourceRecord: PResourceRecord;
                         out Holder: Pointer): Boolean; virtual;
  function OnAllocHotSwapingHolder(ResourceRecord: PResourceRecord;
                                   Original: Pointer;
                                   out Holder: Pointer): Boolean; virtual;
  function OnThreadedLoad(Holder: Pointer): Boolean; virtual;
  function OnLoad(Holder: Pointer): Boolean; virtual;
  function OnUnload(Holder: Pointer): Boolean; virtual;
  function OnThreadedUnload(Holder: Pointer): Boolean; virtual;
  function OnDeallocHolder(Holder: Pointer): Boolean; virtual;
  function OnHotSwap(Old, New: PResourceRecord): Boolean; virtual;
end;

PTextureHolder = ^TTextureHolder;
TTextureHolder = object
private
  FRecord: PResourceRecord;
public
  property GetRecord: PResourceRecord read FRecord;
end;

TTexture = object(specialize TResource<TTextureType, TTextureHolder>)
  procedure Init(const FileName: AnsiString);
  function Load(const FileName: AnsiString): Boolean;
end;

var
  ResourceTexture: TTextureType;

implementation

function IntToStr(Value: LongInt): AnsiString; inline;
begin
  Str(Value, Result);
end;

function UIntToStr(Value: PtrUInt): AnsiString; inline;
begin
  Str(Value, Result);
end;

function PtrToStr(Value: Pointer): AnsiString; inline;
begin
  Result := HexStr(PtrUInt(Value), SizeOf(Pointer) shl 1);
end;

function HolderToStr(Holder: Pointer): AnsiString;
begin
  Result := PtrToStr(Holder) + ' (refs: ' + IntToStr(PTextureHolder(Holder)^.GetRecord^.CountReferences) + ') ';
end;

function TTextureType.GetSingleton: PTextureType;
begin
  Result := @ResourceTexture;
end;

function TTextureType.OnAllocHolder(ResourceRecord: PResourceRecord;
                       Parameters: Pointer;
                       out Holder: Pointer): Boolean;
begin
  New(PTextureHolder(Holder));
  PTextureHolder(Holder)^.FRecord := ResourceRecord;
  Writeln('Allocated holder ', PtrToStr(Holder));
  Exit(True);
end;

function TTextureType.OnAllocDefaultHolder(ResourceRecord: PResourceRecord;
                       out Holder: Pointer): Boolean;
begin
  New(PTextureHolder(Holder));
  PTextureHolder(Holder)^.FRecord := ResourceRecord;
  Writeln('Allocated default holder ', PtrToStr(Holder));
  Exit(True);
end;

function TTextureType.OnAllocHotSwapingHolder(ResourceRecord: PResourceRecord;
                                 Original: Pointer;
                                 out Holder: Pointer): Boolean;
begin
  New(PTextureHolder(Holder));
  PTextureHolder(Holder)^.FRecord := ResourceRecord;
  Writeln('Allocated hotswapping holder ', PtrToStr(Holder), ' for ', HolderToStr(Original));
  Exit(True);
end;

function TTextureType.OnThreadedLoad(Holder: Pointer): Boolean;
begin
  Writeln('Threaded loading ', HolderToStr(Holder));
  Exit(True);
end;

function TTextureType.OnLoad(Holder: Pointer): Boolean;
begin
  Writeln('Loading ', HolderToStr(Holder));
  Exit(True);
end;

function TTextureType.OnUnload(Holder: Pointer): Boolean;
begin
  Writeln('Unloading ', HolderToStr(Holder));
  Exit(True);
end;

function TTextureType.OnThreadedUnload(Holder: Pointer): Boolean;
begin
  Writeln('Threaded unloading ', HolderToStr(Holder));
  Exit(True);
end;

function TTextureType.OnDeallocHolder(Holder: Pointer): Boolean;
begin
  Writeln('Deallocate holder ', HolderToStr(Holder));
  Dispose(PTextureHolder(Holder));
  Exit(True);
end;

function TTextureType.OnHotSwap(Old, New: PResourceRecord): Boolean;
begin
  Writeln('HotSwap ', PtrToStr(Old), ' <-> ', PtrToStr(New));
  Exit(True);
end;

procedure TTexture.Init(const FileName: AnsiString);
begin
  LoadInternal(nil, nil, 'texture "' + FileName + '" ' + IntToStr(0));
end;

function TTexture.Load(const FileName: AnsiString): Boolean;
var
  Id: TResourceId;
begin
  FHolder^.FRecord^.Unref(FPriority);
  Result := LoadInternal(nil, nil, 'texture "' + FileName + '" ' + IntToStr(0));
end;

initialization
  ResourceTexture.Init(TResourceType.FLAG_THREADED_LOAD
                    or TResourceType.FLAG_HOTSWAP);
finalization
  ResourceTexture.Done;
end.
