unit dresourcemanager;
//
//  Global resource manager.
//
//  Features
//
//      * Can be extended to any type of resource
//      * Loading can be done in separate thread
//      * Hot reloading
//

{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

const
  PRIORITY_NORMAL   = 0;
  PRIORITY_REQUIRE  = 1;

type
TResourcePriority = LongInt;

PResourceType = ^TResourceType;
PResourceId = ^TResourceId;
//PResource = ^TResource;
PResourceRecord = ^TResourceRecord;
PResourceManager = ^TResourceManager;

TWriteFunc = function (const Buffer;
                       Count: LongInt;
                       Userdata: Pointer): LongInt;

TResourceType = object
    // Implements all operations for each resource type.
public const
  FLAG_THREADED_LOAD        = 1 shl 0;
  FLAG_THREADED_UNLOAD      = 1 shl 1;
  FLAG_HOTSWAP              = 1 shl 2;
private
  FFlags: Cardinal;
  FIndex: LongInt;
    // Contains unique index for storing the resource type specified data in
    // array. Should be set to -1 in constructor and never changed by client
    // code.
public
  constructor Init(Flags: Cardinal = 0);
  destructor Done; virtual;
  function OnAllocHolder(ResourceRecord: PResourceRecord;
                         Parameters: Pointer;
                         out Holder: Pointer): Boolean; virtual;
      // * Allocates new Holder.
      // * May save the ResourceRecord inside Holder.
      // * Does not save the Parameters pointer, instead it may copy data from
      //   Parameters.
      // * Returns True on success.
      // * Returns False on out-of-memory error.
  function OnAllocDefaultHolder(ResourceRecord: PResourceRecord;
                         out Holder: Pointer): Boolean; virtual;
      // Allocates default Holder (that is, one for type).
  function OnAllocHotSwapingHolder(ResourceRecord: PResourceRecord;
                                   Original: Pointer;
                                   out Holder: Pointer): Boolean; virtual;
      // Allocates Holder that will be hotswapped with the Original.
  function OnThreadedLoad(Holder: Pointer): Boolean; virtual;
      // Starts loading in separated thread. Returns True on success. Returns
      // False and error info in the Holder. Should not block main thread.
  function OnLoad(Holder: Pointer): Boolean; virtual;
      // Continues loading after successful OnThreadedLoad, but in main thread.
  function OnUnload(Holder: Pointer): Boolean; virtual;
      // Unloads the specified resource when it is not needed.
  function OnThreadedUnload(Holder: Pointer): Boolean; virtual;
      // Unloads the specified resource in separated thread.
  function OnDeallocHolder(Holder: Pointer): Boolean; virtual;
      // Deallocates the resource. Returns True on success and False on fail.
  function OnHotSwap(Old, New: PResourceRecord): Boolean; virtual;
      // Swaps data between two specified resource records. Typical
      // implementation is just swapping Holder datas. Returns False on fail,
      // error code stored in the New record.
      // Should not change Holder pointers because concrete resources may
      // cache Holder pointers in their objects.
  property Flags: Cardinal read FFlags;
end;

TResourceHolder = object
    // Holds actual resource data
end;

generic TResource<TConcreteResourceType,
                  TConcreteResourceHolder> = object
    // Concrete TResource can be (but not have to be) inherited from this
    // generic class. The generic implements typical methods for resources.
    // All you need is to provide Load method, resource specific methods and
    // maybe some loading constructors.
    //
    // TConcreteResourceHolder.GetRecord should return PResourceRecord for
    // the specified resource.
protected type
  PConcreteResourceType = ^TConcreteResourceType;
  PConcreteResourceHolder = ^TConcreteResourceHolder;
protected
  FHolder: PConcreteResourceHolder;
  FPriority: TResourcePriority;
  function GetDefault(ResourceManager: PResourceManager): PConcreteResourceHolder;
  function LoadInternal(ResourceManager: PResourceManager;
                        Parameters: Pointer;
                        const Id: AnsiString): Boolean;
    // Loads the resource. Does not destroys current holding reference.
public
  procedure InitDefault(ResourceManager: PResourceManager = nil); overload;
    // Initializes the object with default resource.
  procedure Done;
    // Destroys the object
  procedure CopyTo(var Other: TResource);
    // Copies the resource to another reference
  function Assigned: Boolean;
    // Returns True whenever the object is not default.
  function IsReady: Boolean; inline;
    // Returns True if resource is fully loaded and ready.
  function IsErrorneous: Boolean; inline;
    // Returns True if resource is in error state.
  procedure Require; inline;
    // Marks the resource as required.
  procedure HotReload; inline;
end;

TResourceId = object
    // Unique identifier for resource
private
  FHash: PtrUInt;
  FType: PResourceType;
  FId: AnsiString;
public
  procedure Init(_Type: PResourceType; const Id: AnsiString);
  function GetHash: PtrUInt;
      // Returns hash of the resource id.
  procedure MoveTo(out R: TResourceId);
      // Moves data from Self to uninitialized R and destructs Self.
  function Equal(Other: PResourceId): Boolean;
      // Returns True whenever Self and Other are equal.
end;

TResourceRecord = object
public const
  STATE_ALLOCATED       = 0;
  STATE_THREAD_LOADED   = 1;
  STATE_LOADED          = 2;
private
  FResourceId: TResourceId;
  FHolder: Pointer;
  FReferences: array[0 .. 1] of LongInt;
  FState: Cardinal;
  FResourceManager: PResourceManager;
  FNextInHashTable: PResourceRecord;
  FNextInQue: PResourceRecord;
  FHotswapTarget: PResourceRecord;
  FErrorCode: LongInt;
  FErrorMsg: PAnsiChar;
public
  procedure Init; inline;
      // Initializes the record with default values. Does not change the
      // ResourceId and the Holder.
  procedure Done; inline;
      // Deinitializes
  function HasNoReferenes: Boolean;
  function CountReferences: LongInt;
  procedure ChangePriority(var Priority: TResourcePriority;
                           NewPriority: TResourcePriority);
      //  Changes link's priority from old value in the specified Priority to
      //  new value in the specified NewPriority. Changes Priority to
      //  NewPriority.
  procedure IncRef(Priority: TResourcePriority);
      //  Increments reference count of the specified Priority.
  procedure Unref(var Priority: TResourcePriority);
      //  Removes reference of the specified Priority.
  function SetError(Code: LongInt; Msg: PAnsiChar): Boolean;
      //  Sets the resource to errorneous state, saves the code and the message
      //  and returns False. Typical usage:
      //        if something_bad_happened then
      //          Exit(Record^.SetError(1, 'something bad happened'));
  procedure HotReload;
      //  Create separated (hidden) resource with the same Id. Loads it and if
      //  succeded, OnHotSwaps it with the resource. Do nothing if the resource
      //  type is not allowed hot reload.
  function GetHumanReadableId: AnsiString; inline;
  property ResourceManager: PResourceManager read FResourceManager;
  property Holder: Pointer read FHolder write FHolder;
  property State: Cardinal read FState;
  property ErrorCode: LongInt read FErrorCode;
  property ErrorMsg: PAnsiChar read FErrorMsg;
end;

//TThreadLoader = object
//private
//  FResource: PResourceRecord;
//  FStatus: LongInt;
//end;

TResourceManager = object
private type
  // Hash table
  THashTable = object
  private
    FTable: array of PResourceRecord;
    FSize: SizeUInt;
  public
    procedure Init(Size: SizeUInt);
    procedure Done;
    function Find(ResourceId: PResourceId; out R: PResourceRecord): Boolean;
        //  Searches for Resource Id. Returns True and the record R if found.
        //  Reurns False otherwise.
    function Add(ResourceId: PResourceId; R: PResourceRecord): Boolean;
    procedure Del(R: PResourceRecord);
  end;
private
  FResources: THashTable;
  FUniqueResources: array of PResourceRecord;
  FDefaults: array of PResourceRecord;
  FUnsortedQue: PResourceRecord;
  FThreadedLoadingQue: PResourceRecord;
  FLoadingQue: PResourceRecord;
  FUnloadingQue: PResourceRecord;
  FThreadedUnloadingQue: PResourceRecord;
  FWatchList: PResourceRecord;
  FMultiThreaded: Boolean;
  procedure UnloadUnsafe(Resource: PResourceRecord);
  procedure PutToUnsortedQue(R: PResourceRecord);
private type
  PWorker = ^TWorker;
  TWorker = object
    ResourceManager: PResourceManager;
    Running: Boolean; // Atomic value
  end;
private
  FWorkers: array of TWorker;
  procedure RestartWorkers;
private
  // Pooled allocation
  FPages: array of Pointer;
  FNextFreeRecord: PResourceRecord;
  function NewPage(RecordsInPage: SizeUInt): Pointer;
  function NewRecord: PResourceRecord;
  procedure FreeRecord(R: PResourceRecord);
  procedure FreePages;
public
  constructor Init;
  destructor Done; virtual;
  procedure UnloadDefaultsUnsafe;
  procedure UnloadAllUnsafe;
      // Unload _ALL_ resources. Call this method only if your program will do
      // nothing with resources from the manager.
      // This method is only way to actually deallocate default resource.
  procedure UnloadAll;
      // Unload all unused (that is, without references) resources.
  function GetResource(Id: PResourceId;
                       Parameters: Pointer;
                       out R: PResourceRecord): Boolean;
      //  Returns resource record for the specified Id. Returns True on success,
      //  False on out of memory error.
  function GetUniqueResource(Id: PResourceId;
                       Parameters: Pointer;
                       out R: PResourceRecord): Boolean;
      //  Allocates uniqure resource. That is, it always allocates new resource
      //  and the resource has only one reference.
  function GetDefaultResource(ResourceType: PResourceType;
                              out R: PResourceRecord): Boolean;
      //  Returns default resource for the specified type.
  procedure ProcessUnsortedQue;
  function ProcessThreads: Boolean;
      //  Returns True if the processing was time consuming.
  function ProcessLoading: Boolean;
      //  Processes the FLoadingQue. Returns True if the processing was time
      //  consuming.
  function ProcessUnloading: Boolean;
  function ProcessWatchList: Boolean;
  function UpdateStep: Boolean;
      //  Performs smallest update step possible.
  property MultiThreaded: Boolean read FMultiThreaded write FMultiThreaded;
      //  If True, it calls OnThreadedLoad and OnThreadedUnload in separated
      //  threads. Default value is False.
end;

var
  ResourceManager: TResourceManager;

function ActualResourceManager(Param: PResourceManager): PResourceManager; inline;
      //  Returns Param if Param<>nil, returns @ResourceManager otherwise.

implementation

function ThreadedLoading(Worker: Pointer): PtrInt;
begin
  TResourceManager.PWorker(Worker)^.Running := False;
  Exit(0);
end;

constructor TResourceType.Init(Flags: Cardinal = 0);
begin
  FFlags := Flags;
  FIndex := -1;
end;

destructor TResourceType.Done;
begin
end;

function TResourceType.OnAllocHolder(ResourceRecord: PResourceRecord;
                         Parameters: Pointer;
                         out Holder: Pointer): Boolean;
begin
  Holder := nil;
  Exit(True);
end;

function TResourceType.OnAllocDefaultHolder(ResourceRecord: PResourceRecord;
                         out Holder: Pointer): Boolean;
begin
  Holder := nil;
  Exit(False);
end;

function TResourceType.OnAllocHotSwapingHolder(ResourceRecord: PResourceRecord;
                                 Original: Pointer;
                                 out Holder: Pointer): Boolean;
begin
  Holder := nil;
  Exit(False);
end;

function TResourceType.OnThreadedLoad(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TResourceType.OnLoad(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TResourceType.OnUnload(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TResourceType.OnThreadedUnload(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TResourceType.OnDeallocHolder(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TResourceType.OnHotSwap(Old, New: PResourceRecord): Boolean;
begin
  // Not implemented
  Exit(False);
end;

function TResource.GetDefault(ResourceManager: PResourceManager): PConcreteResourceHolder;
var
  R: PResourceRecord;
begin
  if ResourceManager^.GetDefaultResource(TConcreteResourceType.GetSingleton, R) then begin
    Result := R^.Holder;
  end else
    Result := nil;
end;

function TResource.LoadInternal(ResourceManager: PResourceManager;
                                Parameters: Pointer;
                                const Id: AnsiString): Boolean;
var
  ResourceId: TResourceId;
  R: PResourceRecord;
begin
  ResourceId.Init(TConcreteResourceType.GetSingleton, Id);
  Result := ActualResourceManager(ResourceManager)^.GetResource(@ResourceId, Parameters, R);
  if Result then begin
    FHolder := R^.Holder;
    FPriority := PRIORITY_NORMAL;
    R^.IncRef(FPriority);
  end;
end;

procedure TResource.InitDefault(ResourceManager: PResourceManager = nil);
begin
  FHolder := GetDefault(ActualResourceManager(ResourceManager));
end;

procedure TResource.Done;
begin
  FHolder^.GetRecord^.Unref(FPriority);
end;

procedure TResource.CopyTo(var Other: TResource);
begin
  Other.FHolder := FHolder;
  Other.FPriority := FPriority;
  FHolder^.GetRecord^.IncRef(FPriority);
end;

function TResource.Assigned: Boolean;
begin
  Exit(FHolder = GetDefault(FHolder^.GetRecord^.ResourceManager));
end;

function TResource.IsReady: Boolean;
begin
  Result := FHolder^.GetRecord^.State = TResourceRecord.STATE_LOADED;
end;

function TResource.IsErrorneous: Boolean;
begin
  Result := FHolder^.GetRecord^.ErrorCode <> 0;
end;

procedure TResource.Require;
begin
  FHolder^.GetRecord^.ChangePriority(FPriority, PRIORITY_REQUIRE);
end;

procedure TResource.HotReload;
begin
  FHolder^.GetRecord^.HotReload;
end;

function _GetHash(S, SEnd: PByte; Test: Cardinal): PtrUInt; inline;
  // Returns pjw32 hash. The Test is just a local variable for optimization.
begin
  Result := 0;
  while S < SEnd do begin
    Result := (Result shl 4) or Byte(S^);
    Test := Result and $f0000000;
    if Test <> 0 then
      Result := (Result xor (Result shr 24)) and $fffffff;
    Inc(S);
  end;
end;

procedure TResourceId.Init(_Type: PResourceType; const Id: AnsiString);
begin
  FType := _Type;
  FId := Id;
  FHash := _GetHash(@Id, PByte(@Id) + Length(Id), 0);
end;

function TResourceId.GetHash: PtrUInt;
begin
  Result := PtrUInt(FType) shr 4;
end;

procedure TResourceId.MoveTo(out R: TResourceId);
begin
  R := Self;
end;

function TResourceId.Equal(Other: PResourceId): Boolean;
begin
  Result := (FType = Other^.FType) and (FId = Other^.FId);
end;

procedure TResourceRecord.Init;
var
  I: LongInt;
begin
  // Do not affect FResourceId
  // Do not affect FHolder
  for I := 0 to High(FReferences) do
    FReferences[I] := 0;
  FState := STATE_ALLOCATED;
  // Do not affect FResourceManager
  // Do not affect FNextInHashTable
  // Do not affect FNextInQue
  FErrorCode := 0;
  FErrorMsg := '';
end;

procedure TResourceRecord.Done;
begin
end;

function TResourceRecord.HasNoReferenes: Boolean;
begin
  Result := (FReferences[0] = 0) and
            (FReferences[1] = 0);
end;

function TResourceRecord.CountReferences: LongInt;
begin
  Result := FReferences[0] + FReferences[1];
end;

procedure TResourceRecord.ChangePriority(var Priority: TResourcePriority;
                         NewPriority: TResourcePriority);
begin
  Dec(FReferences[Priority and 1]);
  Inc(FReferences[NewPriority and 1]);
  Priority := NewPriority;
end;

procedure TResourceRecord.IncRef(Priority: TResourcePriority);
begin
  Inc(FReferences[Priority and 1]);
end;

procedure TResourceRecord.Unref(var Priority: TResourcePriority);
begin
  Dec(FReferences[Priority and 1]);
end;

function TResourceRecord.SetError(Code: LongInt; Msg: PAnsiChar): Boolean;
begin
  FErrorCode := Code;
  FErrorMsg := Msg;
  Exit(False);
end;

procedure TResourceRecord.HotReload;
var
  R: PResourceRecord;
begin
  if FResourceId.FType^.FFlags and TResourceType.FLAG_HOTSWAP = 0 then
    Exit;
  R := FResourceManager^.NewRecord;
  R^.Init;
  R^.FHolder := nil;
  if not FResourceId.FType^.OnAllocHotSwapingHolder(@Self, FHolder, R^.FHolder) then begin
    FResourceManager^.FreeRecord(R);
    Exit;
  end;
  FResourceManager^.PutToUnsortedQue(R);
  R^.FResourceId := FResourceId; // FIXME
  R^.FResourceManager := FResourceManager;
  R^.FReferences[0] := 1;
  R^.FReferences[1] := 0;
  R^.FHotswapTarget := @Self;
end;

function TResourceRecord.GetHumanReadableId: AnsiString;
begin
  Result := FResourceId.FId;
end;

procedure TResourceManager.UnloadUnsafe(Resource: PResourceRecord);
var
  T: PResourceType;
begin
  T := Resource^.FResourceId.FType;
  T^.OnThreadedUnload(Resource^.Holder);
end;

procedure TResourceManager.PutToUnsortedQue(R: PResourceRecord);
begin
  R^.FNextInQue := FUnsortedQue;
  FUnsortedQue := R;
end;

procedure TResourceManager.RestartWorkers;
var
  I: LongInt;
begin
  for I := 0 to High(FWorkers) do begin
    if not FWorkers[I].Running then begin // fix me use atomic
      FWorkers[I].Running := True;
      BeginThread(@ThreadedLoading, @FWorkers[I]);
    end;
  end;
end;

function TResourceManager.NewPage(RecordsInPage: SizeUInt): Pointer;
var
  R, REnd: PResourceRecord;
begin
  R := GetMem(RecordsInPage * SizeOf(TResourceRecord));
  Result := R;
  if R <> nil then begin
    SetLength(FPages, Length(FPages) + 1);
    FPages[High(FPages)] := R;
    REnd := R + RecordsInPage - 1;
    while R < REnd do begin
      R^.FNextInHashTable := R + 1;
      Inc(R);
    end;
    R^.FNextInHashTable := nil;
  end;
end;

function TResourceManager.NewRecord: PResourceRecord;
const
  RECORDS_IN_PAGE = 1024;
var
  R, It: PResourceRecord;
begin
  if FNextFreeRecord = nil then begin
    R := NewPage(RECORDS_IN_PAGE);
    FNextFreeRecord := R + 1;
    Exit(R);
  end;
  Result := FNextFreeRecord;
  Initialize(Result^);
  FNextFreeRecord := FNextFreeRecord^.FNextInHashTable;
end;

procedure TResourceManager.FreeRecord(R: PResourceRecord);
begin
  R^.FNextInHashTable := FNextFreeRecord;
  FNextFreeRecord := R;
  Finalize(R^);
end;

procedure TResourceManager.FreePages;
var
  I: LongInt;
begin
  for I := 0 to High(FPages) do begin
    FreeMem(FPages[I]);
  end;
  SetLength(FPages, 0);
end;

procedure TResourceManager.THashTable.Init(Size: SizeUInt);
var
  I: LongInt;
begin
  FSize := Size;
  SetLength(FTable, Size);
  for I := 0 to Size - 1 do
    FTable[I] := nil;
end;

procedure TResourceManager.THashTable.Done;
begin
  SetLength(FTable, 0);
end;

function TResourceManager.THashTable.Find(ResourceId: PResourceId; out R: PResourceRecord): Boolean;
var
  It: PResourceRecord;
begin
  It := FTable[ResourceId^.FHash mod FSize];
  while It <> nil do begin
    if It^.FResourceId.FId = ResourceId^.FId then begin
      R := It;
      Exit(True);
    end;
    It := It^.FNextInHashTable;
  end;
  Exit(False);
end;

function TResourceManager.THashTable.Add(ResourceId: PResourceId; R: PResourceRecord): Boolean;
begin
  R^.FNextInHashTable := FTable[ResourceId^.FHash mod FSize];
  FTable[ResourceId^.FHash mod FSize] := R;
  Result := True;
end;

procedure TResourceManager.THashTable.Del(R: PResourceRecord);
var
  Prev: Pointer;
  It: PResourceRecord;
begin
  Prev := @FTable[R^.FResourceId.FHash mod FSize];
  It := PResourceRecord(Prev^);
  while It <> nil do begin
    if It = R then begin
      PResourceRecord(Prev^) := It^.FNextInHashTable;
      Exit;
    end;
    Prev := @It^.FNextInHashTable;
    It := PResourceRecord(Prev^);
  end;
end;

constructor TResourceManager.Init;
begin
  FNextFreeRecord := nil;
  FResources.Init(4 * 1024);
  FUnsortedQue := nil;
  FThreadedLoadingQue := nil;
  FLoadingQue := nil;
  FUnloadingQue := nil;
  FThreadedUnloadingQue := nil;
  FWatchList := nil;
  FMultiThreaded := False;
end;

destructor TResourceManager.Done;
begin
  FResources.Done;
end;

procedure TResourceManager.UnloadDefaultsUnsafe;
var
  I: LongInt;
  R: PResourceRecord;
begin
  for I := 0 to High(FDefaults) do begin
    R := FDefaults[I];
    // Free immediatly
    if R^.FState = TResourceRecord.STATE_LOADED then begin
      R^.FResourceId.FType^.OnUnload(R^.FHolder);
      R^.FState := TResourceRecord.STATE_THREAD_LOADED;
    end;
    if (R^.FState = TResourceRecord.STATE_THREAD_LOADED) and (R^.FResourceId.FType^.FFlags and TResourceType.FLAG_THREADED_UNLOAD <> 0) then
      R^.FResourceId.FType^.OnThreadedUnload(R^.FHolder);
    R^.FResourceId.FType^.OnDeallocHolder(R^.FHolder);
    FResources.Del(R);
    FreeRecord(R);
  end;
  SetLength(FDefaults, 0);
end;

procedure TResourceManager.UnloadAllUnsafe;
begin
  UnloadDefaultsUnsafe;
end;

procedure TResourceManager.UnloadAll;
var
  I: LongInt;
  Prev, It: PResourceRecord;
begin
  I := 0;
  while I <= High(FResources.FTable) do begin
    Prev := nil;
    It := FResources.FTable[I];
    while It <> nil do begin
      if It^.HasNoReferenes then begin
        UnloadUnsafe(It);
        if Prev <> nil then begin
          Prev^.FNextInHashTable := It^.FNextInHashTable;
        end else
          FResources.FTable[I] := It^.FNextInHashTable;
        It^.Done;
        FreeRecord(It);
      end else
        Inc(I);
    end;
    Inc(I);
  end;
end;

function TResourceManager.GetResource(Id: PResourceId;
                     Parameters: Pointer;
                     out R: PResourceRecord): Boolean;
var
  I: LongInt;
begin
  if FResources.Find(Id, R) then
    Exit(True);
  R := NewRecord;
  Initialize(R^);
  R^.Init;
  Id^.MoveTo(R^.FResourceId);
  R^.FHolder := nil;
  R^.FResourceManager := @Self;
  if not R^.FResourceId.FType^.OnAllocHolder(R, Parameters, R^.FHolder) then begin
    // TODO destroy R^.FResourceId
    Dispose(R);
    Exit(False);
  end;
  FResources.Add(Id, R);
  PutToUnsortedQue(R);
  R^.FReferences[0] := 0;
  R^.FReferences[1] := 0;
  R^.FHotswapTarget := nil;
  Exit(True);
end;

function TResourceManager.GetUniqueResource(Id: PResourceId;
                   Parameters: Pointer;
                   out R: PResourceRecord): Boolean;
begin
  SetLength(FUniqueResources, Length(FUniqueResources) + 1);
  New(R);
  FUniqueResources[High(FUniqueResources)] := R;
  Id^.MoveTo(R^.FResourceId);
  if not R^.FResourceId.FType^.OnAllocHolder(R, Parameters, R^.FHolder) then begin
    SetLength(FUniqueResources, Length(FUniqueResources) - 1);
    Dispose(R);
    Exit(False);
  end;
  R^.FReferences[0] := 0;
  R^.FReferences[1] := 0;
  Exit(True);
end;

function TResourceManager.GetDefaultResource(ResourceType: PResourceType;
                            out R: PResourceRecord): Boolean;
begin
  if ResourceType^.FIndex = -1 then begin
    New(R);
    if not ResourceType^.OnAllocDefaultHolder(R, R^.FHolder) then begin
      Dispose(R);
      Exit(False);
    end;
    SetLength(FDefaults, Length(FDefaults) + 1);
    ResourceType^.FIndex := High(FDefaults);
    FDefaults[ResourceType^.FIndex] := R;
    R^.FResourceId.FType := ResourceType;
    if ResourceType^.OnThreadedLoad(R^.FHolder) then
      R^.FState := TResourceRecord.STATE_THREAD_LOADED;
    if ResourceType^.OnLoad(R^.FHolder) then
      R^.FState := TResourceRecord.STATE_LOADED;
    Exit(True);
  end;
  R := FDefaults[ResourceType^.FIndex];
  Exit(True);
end;

procedure XMove(var Q1: PResourceRecord; var Q2: PResourceRecord);
var
  R: PResourceRecord;
begin
  R := Q1;
  Q1 := R^.FNextInQue;
  R^.FNextInQue := Q2;
  Q2 := R;
end;

procedure FreeAndPop(Manager: PResourceManager; var Q: PResourceRecord);
var
  R: PResourceRecord;
begin
  R := Q;
  Q := R^.FNextInQue;
  Manager^.FreeRecord(R);
end;

procedure Pop(var Q: PResourceRecord);
var
  R: PResourceRecord;
begin
  R := Q;
  Q := R^.FNextInQue;
  R^.FNextInQue := nil;
end;

procedure TResourceManager.ProcessUnsortedQue;
begin
  while FUnsortedQue <> nil do begin
    case FUnsortedQue^.FState of
      TResourceRecord.STATE_ALLOCATED: begin
            if FUnsortedQue^.HasNoReferenes then begin
              // Free immediatly
              FUnsortedQue^.FResourceId.FType^.OnDeallocHolder(FUnsortedQue^.FHolder);
              FResources.Del(FUnsortedQue);
              FreeAndPop(@Self, FUnsortedQue);
            end else begin
              if FUnsortedQue^.FResourceId.FType^.Flags and TResourceType.FLAG_THREADED_LOAD <> 0 then begin
                XMove(FUnsortedQue, FThreadedLoadingQue);
              end else
                XMove(FUnsortedQue, FLoadingQue);
            end;
            continue;
          end;
      TResourceRecord.STATE_THREAD_LOADED: begin
            if FUnsortedQue^.HasNoReferenes then begin
              if FUnsortedQue^.FResourceId.FType^.Flags and TResourceType.FLAG_THREADED_LOAD <> 0 then begin
                XMove(FUnsortedQue, FThreadedUnloadingQue);
              end else begin
                // Free immediatly
                FUnsortedQue^.FResourceId.FType^.OnDeallocHolder(FUnsortedQue^.FHolder);
                FResources.Del(FUnsortedQue);
                FreeAndPop(@Self, FUnsortedQue);
              end;
            end else
              XMove(FUnsortedQue, FLoadingQue);
            continue;
          end;
      TResourceRecord.STATE_LOADED: begin
            if FUnsortedQue^.FHotswapTarget <> nil then begin
              FUnsortedQue^.FResourceId.FType^.OnHotSwap(FUnsortedQue, FUnsortedQue^.FHotswapTarget);
              FUnsortedQue^.FHotswapTarget^.FReferences[0] := 0;
              FUnsortedQue^.FHotswapTarget^.FReferences[1] := 0;
              FUnsortedQue^.FHotswapTarget := nil;
              XMove(FUnsortedQue, FUnloadingQue);
            end else begin
              if FUnsortedQue^.HasNoReferenes then begin
                XMove(FUnsortedQue, FUnloadingQue);
              end else
                XMove(FUnsortedQue, FWatchList);
            end;
            continue;
          end;
    end;
    // ???
    FUnsortedQue := FUnsortedQue^.FNextInQue;
  end;
end;

function TResourceManager.ProcessThreads: Boolean;
var
  R: PResourceRecord;
begin
  // Put tasks into que
  if FMultiThreaded then begin
    while FThreadedLoadingQue <> nil do begin
      // Extract the record from the que
      R := FThreadedLoadingQue;
      FThreadedLoadingQue := R^.FNextInQue;
      R^.FNextInQue := nil;
      // Put the record into threaded que
      //   ThreadedQue.Put(R);
      // (Re)start loading threads if they are not active
      RestartWorkers;
    end;
  end else begin
    if FThreadedLoadingQue <> nil then begin
      if FThreadedLoadingQue^.FResourceId.FType^.OnThreadedLoad(FThreadedLoadingQue^.FHolder) then begin
        FThreadedLoadingQue^.FState := TResourceRecord.STATE_THREAD_LOADED;
        XMove(FThreadedLoadingQue, FUnsortedQue);
      end else begin
        // TODO we should mark the resource as errorneous
        Pop(FThreadedLoadingQue);
      end;
      Exit(True);
    end;
  end;
  // Check for ready tasks
  // We assume that all hard work is done in separated thread
  Result := False;
end;

function TResourceManager.ProcessLoading: Boolean;
begin
  if FLoadingQue <> nil then begin
    if FLoadingQue^.FResourceId.FType^.OnLoad(FLoadingQue^.FHolder) then begin
      FLoadingQue^.FState := TResourceRecord.STATE_LOADED;
      XMove(FLoadingQue, FUnsortedQue);
    end else begin
      // TODO we should mark the resource as errorneous
      Pop(FLoadingQue);
    end;
    Exit(True);
  end;
  Exit(False);
end;

function TResourceManager.ProcessUnloading: Boolean;
begin
  if FUnloadingQue <> nil then begin
    FUnloadingQue^.FResourceId.FType^.OnUnload(FUnloadingQue^.FHolder);
    FUnloadingQue^.FState := TResourceRecord.STATE_THREAD_LOADED;
    XMove(FUnloadingQue, FUnsortedQue);
    Exit(True);
  end;
  Exit(False);
end;

function TResourceManager.ProcessWatchList: Boolean;
var
  Prev: Pointer;
  It: PResourceRecord;
begin
  Prev := @FWatchList;
  It := PResourceRecord(Prev^);
  Result := False;
  while It <> nil do begin
    if It^.HasNoReferenes then begin
      XMove(PResourceRecord(Prev^), FUnsortedQue);
      Result := True;
    end else
      Prev := @It^.FNextInQue;
    It := PResourceRecord(Prev^);
  end;
end;

function TResourceManager.UpdateStep: Boolean;
begin
  // We should proccess all unsorted records because there can be high priority
  // resources at the end of the list. Fortunetly it is fast.
  ProcessUnsortedQue;
  // Now manage threaded loading
  if ProcessThreads then
    Exit(True);
  // Process regular loading
  if ProcessLoading then
    Exit(True);
  // Watch list is not a que -- we do not pop an element on each process step.
  // Instead, we check if something has been changed
  Result := ProcessWatchList;
  // Process regular unloading
  if ProcessUnloading then
    Exit(True);
  // If we are here, we return result of ProcessWatchList
end;

function ActualResourceManager(Param: PResourceManager): PResourceManager;
begin
  if Param = nil then begin
    Exit(@ResourceManager);
  end else
    Exit(Param);
end;

initialization
  ResourceManager.Init;
finalization
  ResourceManager.Done;
end.
