{$MODE OBJFPC} { -*- delphi -*- }
{$INCLUDE settings.inc}
unit wrappers;

interface

{$IFNDEF ENDIAN_LITTLE}
{$ERROR This unit assumes a little-endian target.}
{$ENDIF}

uses
   systems;

type
   NoFlags = (nfFlag1, nfFlag2);
   
   // automatically resolves to the first matching feature of the asset on read
   generic TAssetOrFeature <T: TFeatureNode; C: TFeatureClass; F> = record // F is an enum with up to two values
   private
      FData: PtrUInt;
      procedure ResolveBody();
      function GetAssigned(): Boolean; inline;
      function GetResolved(): Boolean; inline;
      class operator Copy(constref Src: TAssetOrFeature; var Dst: TAssetOrFeature); unimplemented;
   public
      procedure AssignAsset(AssetNode: TAssetNode); inline; // resets flags // it's an error if AssetNode cannot resolve to an appropriate feature
      procedure AssignFeature(Feature: T); inline; // resets flags
      procedure Clear(); inline; // resets flags
      function Resolve(): Boolean; inline;
      function Unwrap(): T; inline; // must be Resolved; safe even if not assigned (returns nil)
      procedure SetFlag(Flag: F); inline;
      procedure ClearFlag(Flag: F); inline;
      procedure ConfigureFlag(Flag: F; Enabled: Boolean); inline;
      function IsFlagSet(Flag: F): Boolean; inline;
      function IsFlagClear(Flag: F): Boolean; inline;
      property Assigned: Boolean read GetAssigned;
      property Resolved: Boolean read GetResolved;
   end;

const
   kIsAsset = $04;
   kFlagsMask = $03;
   kAnnotationsMask = $07;

implementation

uses
   sysutils;

{$IF (kFlagsMask and kIsAsset) <> 0}
  {$ERROR Flag bits overlap the asset marker bit}
{$ENDIF}
{$IF (kFlagsMask or kIsAsset) <> kAnnotationsMask}
  {$ERROR kAnnotationsMask must equal kFlagsMask + kIsAsset}
{$ENDIF}

class operator TAssetOrFeature.Copy(constref Src: TAssetOrFeature; var Dst: TAssetOrFeature);
begin
   raise Exception.Create('Attempted to copy a TAssetOrFeature.');
end;

procedure TAssetOrFeature.AssignAsset(AssetNode: TAssetNode);
begin
   {$IF SIZEOF(F) > SIZEOF(PtrUInt)}
     {$ERROR Flags type does not fit in a PtrUInt}
   {$ENDIF}
   Assert(system.Assigned(AssetNode));
   Assert((PtrUInt(AssetNode) and kAnnotationsMask) = 0);
   FData := PtrUInt(AssetNode) or kIsAsset;
end;

procedure TAssetOrFeature.AssignFeature(Feature: T);
begin
   Assert(system.Assigned(Feature));
   Assert((PtrUInt(Feature) and kAnnotationsMask) = 0);
   FData := PtrUInt(Feature);
end;

procedure TAssetOrFeature.Clear();
begin
   FData := $00;
end;

procedure TAssetOrFeature.ResolveBody();
var
   AssetNode: TAssetNode;
   Feature: TFeatureNode;
begin
   Assert((FData and kIsAsset) = kIsAsset);
   AssetNode := TAssetNode(FData and not PtrUInt(kAnnotationsMask));
   Assert(system.Assigned(AssetNode));
   Feature := AssetNode.GetFeatureByClass(C); // must not be nil
   Assert(system.Assigned(Feature));
   Assert((PtrUInt(Feature) and kAnnotationsMask) = 0);
   FData := PtrUInt(Feature) or (FData and kFlagsMask);
end;

function TAssetOrFeature.GetAssigned(): Boolean;
begin
   Result := (FData and not PtrUInt(kAnnotationsMask)) <> 0;
end;

function TAssetOrFeature.GetResolved(): Boolean;
begin
   Result := ((FData and not PtrUInt(kAnnotationsMask)) <> 0) and ((FData and kIsAsset) = 0);
end;

function TAssetOrFeature.Resolve(): Boolean;
begin
   Result := (FData and kIsAsset) <> 0;
   if (Result) then
      ResolveBody();
end;

function TAssetOrFeature.Unwrap(): T;
begin
   Assert((FData and kIsAsset) = 0);
   Result := T(FData and not PtrUInt(kAnnotationsMask));
end;

procedure TAssetOrFeature.SetFlag(Flag: F);
var
   Value: PtrUInt;
begin
   Value := 1 << Ord(Flag); // $R-
   Assert(Value <= kFlagsMask);
   FData := FData or Value;
end;

procedure TAssetOrFeature.ClearFlag(Flag: F);
var
   Value: PtrUInt;
begin
   Value := 1 << Ord(Flag); // $R-
   Assert(Value <= kFlagsMask);
   FData := FData and not Value;
end;

procedure TAssetOrFeature.ConfigureFlag(Flag: F; Enabled: Boolean);
var
   Value: PtrUInt;
begin
   Value := 1 << Ord(Flag); // $R-
   Assert(Value <= kFlagsMask);
   if (Enabled) then
      FData := FData or Value
   else
      FData := FData and not Value;
end;

function TAssetOrFeature.IsFlagSet(Flag: F): Boolean;
var
   Value: PtrUInt;
begin
   Value := 1 << Ord(Flag); // $R-
   Assert(Value <= kFlagsMask);
   Result := FData and Value <> 0;
end;

function TAssetOrFeature.IsFlagClear(Flag: F): Boolean;
var
   Value: PtrUInt;
begin
   Value := 1 << Ord(Flag); // $R-
   Assert(Value <= kFlagsMask);
   Result := FData and Value = 0;
end;

end.