Indicator with new types
This commit is contained in:
@@ -8,7 +8,7 @@ uses
|
|||||||
TestModule in 'TestModule.pas',
|
TestModule in 'TestModule.pas',
|
||||||
DynamicFMXControl in 'DynamicFMXControl.pas',
|
DynamicFMXControl in 'DynamicFMXControl.pas',
|
||||||
Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas',
|
Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas',
|
||||||
Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.pas',
|
Myc.Trade.Indicators_v2 in '..\Src\Myc.Trade.Indicators_v2.pas',
|
||||||
Strategy2 in 'Strategy2.pas';
|
Strategy2 in 'Strategy2.pas';
|
||||||
|
|
||||||
{$R *.res}
|
{$R *.res}
|
||||||
|
|||||||
@@ -70,7 +70,7 @@
|
|||||||
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
||||||
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
|
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
|
||||||
<SanitizedProjectName>AuraTrader</SanitizedProjectName>
|
<SanitizedProjectName>AuraTrader</SanitizedProjectName>
|
||||||
<DCC_UnitSearchPath>T:\Myc\Src;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
<DCC_UnitSearchPath>T:\Myc\Src;T:\Myc\Src\Data;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
||||||
<VerInfo_Locale>1031</VerInfo_Locale>
|
<VerInfo_Locale>1031</VerInfo_Locale>
|
||||||
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
@@ -138,7 +138,7 @@
|
|||||||
<DCCReference Include="TestModule.pas"/>
|
<DCCReference Include="TestModule.pas"/>
|
||||||
<DCCReference Include="DynamicFMXControl.pas"/>
|
<DCCReference Include="DynamicFMXControl.pas"/>
|
||||||
<DCCReference Include="..\Src\Myc.Trade.Pipeline.Impl.pas"/>
|
<DCCReference Include="..\Src\Myc.Trade.Pipeline.Impl.pas"/>
|
||||||
<DCCReference Include="..\Src\Myc.Trade.Indicators.pas"/>
|
<DCCReference Include="..\Src\Myc.Trade.Indicators_v2.pas"/>
|
||||||
<DCCReference Include="Strategy2.pas"/>
|
<DCCReference Include="Strategy2.pas"/>
|
||||||
<BuildConfiguration Include="Base">
|
<BuildConfiguration Include="Base">
|
||||||
<Key>Base</Key>
|
<Key>Base</Key>
|
||||||
|
|||||||
@@ -0,0 +1,626 @@
|
|||||||
|
unit Myc.Trade.Indicators_V2;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$M+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.TypInfo,
|
||||||
|
System.Rtti,
|
||||||
|
Myc.Data.Pipeline,
|
||||||
|
Myc.Data.Types,
|
||||||
|
System.Classes;
|
||||||
|
|
||||||
|
type
|
||||||
|
TIndicatorFactoryProc<TParams, TArgs, TResult> = reference to function(const Params: TParams): TConvertFunc<TArgs, TResult>;
|
||||||
|
|
||||||
|
(*
|
||||||
|
Sample definition of an indicator template:
|
||||||
|
|
||||||
|
type
|
||||||
|
[IndicatorName('HMA', 'Hull Moving Average')]
|
||||||
|
[IndicatorHint('A fast, smooth moving average that minimizes lag.')]
|
||||||
|
THMA = class
|
||||||
|
type
|
||||||
|
TParams = record
|
||||||
|
Period: Integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TArgs = record
|
||||||
|
Value: Double;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TResult = record
|
||||||
|
HMA: Double;
|
||||||
|
end;
|
||||||
|
|
||||||
|
[IndicatorFactory]
|
||||||
|
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
|
||||||
|
|
||||||
|
// Hard coded version:
|
||||||
|
class function CreateHMA( Period: Integer ): TConvertFunc<Double, Double>; static;
|
||||||
|
end;
|
||||||
|
*)
|
||||||
|
|
||||||
|
IndicatorFactoryAttribute = class(TCustomAttribute);
|
||||||
|
|
||||||
|
// Attribute to provide a short and a long name for an indicator.
|
||||||
|
IndicatorNameAttribute = class(TCustomAttribute)
|
||||||
|
private
|
||||||
|
FName: string;
|
||||||
|
FShortName: string;
|
||||||
|
public
|
||||||
|
constructor Create(const AShortName, AName: string);
|
||||||
|
property ShortName: string read FShortName;
|
||||||
|
property Name: string read FName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Attribute to provide a descriptive hint for an indicator.
|
||||||
|
IndicatorHintAttribute = class(TCustomAttribute)
|
||||||
|
private
|
||||||
|
FHint: string;
|
||||||
|
public
|
||||||
|
constructor Create(const AHint: string);
|
||||||
|
property Hint: string read FHint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TFieldDef = record
|
||||||
|
public
|
||||||
|
Identifier: String;
|
||||||
|
// Use the custom type system instead of PTypeInfo.
|
||||||
|
DataType: IDataType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TFieldLayout = TArray<TFieldDef>;
|
||||||
|
|
||||||
|
// Interface for creating an indicator instance. Only contains functional aspects.
|
||||||
|
IIndicatorFactory = interface
|
||||||
|
function GetParamType: IDataType;
|
||||||
|
function GetArgType: IDataType;
|
||||||
|
function GetResultType: IDataType;
|
||||||
|
|
||||||
|
function CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>;
|
||||||
|
|
||||||
|
// Provides direct access to the type information of parameters, arguments, and results.
|
||||||
|
property ParamType: IDataType read GetParamType;
|
||||||
|
property ArgType: IDataType read GetArgType;
|
||||||
|
property ResultType: IDataType read GetResultType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
|
||||||
|
private
|
||||||
|
FFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
|
||||||
|
FName: String;
|
||||||
|
FShortName: String;
|
||||||
|
FHint: String;
|
||||||
|
FParamType: IDataType;
|
||||||
|
FArgType: IDataType;
|
||||||
|
FResultType: IDataType;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(
|
||||||
|
const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
|
||||||
|
const AShortName, AName, AHint: String;
|
||||||
|
const AParamType, AArgType, AResultType: IDataType
|
||||||
|
);
|
||||||
|
|
||||||
|
// IIndicatorFactory
|
||||||
|
function GetParamType: IDataType;
|
||||||
|
function GetArgType: IDataType;
|
||||||
|
function GetResultType: IDataType;
|
||||||
|
function CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>; overload;
|
||||||
|
|
||||||
|
class function CreateFromTemplate<T>: TGenericIndicatorFactory;
|
||||||
|
|
||||||
|
function CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; overload;
|
||||||
|
|
||||||
|
property Name: String read FName;
|
||||||
|
property ShortName: String read FShortName;
|
||||||
|
property Hint: String read FHint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TIndicatorRegistry = class
|
||||||
|
public
|
||||||
|
// Represents a registered indicator, combining the factory with its metadata.
|
||||||
|
type
|
||||||
|
TItem = class
|
||||||
|
private
|
||||||
|
FFactory: IIndicatorFactory;
|
||||||
|
FName: string;
|
||||||
|
FShortName: string;
|
||||||
|
FHint: string;
|
||||||
|
public
|
||||||
|
constructor Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string);
|
||||||
|
function CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; overload;
|
||||||
|
property Factory: IIndicatorFactory read FFactory;
|
||||||
|
property Name: string read FName;
|
||||||
|
property ShortName: string read FShortName;
|
||||||
|
property Hint: string read FHint;
|
||||||
|
end;
|
||||||
|
private
|
||||||
|
FItems: TArray<TItem>;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
// Writes the contents of the registry (just like the log)
|
||||||
|
procedure LogRegistry(const Log: TStrings);
|
||||||
|
|
||||||
|
// Register indicator from a template class
|
||||||
|
procedure RegisterTemplate<TIndicatorTemplate>;
|
||||||
|
|
||||||
|
// Register a pre-built indicator factory
|
||||||
|
procedure RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String);
|
||||||
|
|
||||||
|
// Find a registered factory by its short name
|
||||||
|
function Find(const ShortName: string): TItem;
|
||||||
|
|
||||||
|
// Provides read-only access to the list of all registered indicator items
|
||||||
|
property Items: TArray<TItem> read FItems;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
IndicatorRegistry: TIndicatorRegistry;
|
||||||
|
|
||||||
|
function DataValueFromTValue(const aValue: TValue): IDataValue;
|
||||||
|
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils;
|
||||||
|
|
||||||
|
// =================================================================================================
|
||||||
|
// == Helper functions for type conversion
|
||||||
|
// =================================================================================================
|
||||||
|
|
||||||
|
// Converts an RTTI type object into an IDataType from the custom type system.
|
||||||
|
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;
|
||||||
|
begin
|
||||||
|
if not Assigned(rttiType) then
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case rttiType.TypeKind of
|
||||||
|
tkInteger, tkInt64, tkEnumeration: Result := TDataType.Ordinal;
|
||||||
|
tkFloat: Result := TDataType.Float;
|
||||||
|
tkString, tkUString: Result := TDataType.Text;
|
||||||
|
tkRecord:
|
||||||
|
begin
|
||||||
|
var rttiRecord := rttiType as TRttiRecordType;
|
||||||
|
var recordFields := TArray<TRecordField>.Create();
|
||||||
|
for var rttiField in rttiRecord.GetFields do
|
||||||
|
begin
|
||||||
|
var fieldType := DataTypeFromRttiType(Ctx, rttiField.FieldType);
|
||||||
|
recordFields := recordFields + [TRecordField.Create(rttiField.Name, fieldType)];
|
||||||
|
end;
|
||||||
|
Result := TDataType.RecordOf(recordFields);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
raise ENotSupportedException.CreateFmt(
|
||||||
|
'Unsupported RTTI TypeKind "%s" for indicator templates.',
|
||||||
|
[GetEnumName(TypeInfo(TTypeKind), Ord(rttiType.TypeKind))]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Converts a TValue into an IDataValue. This is the bridge from RTTI to the custom type system.
|
||||||
|
function DataValueFromTValue(const aValue: TValue): IDataValue;
|
||||||
|
var
|
||||||
|
ctx: TRttiContext;
|
||||||
|
begin
|
||||||
|
if aValue.IsEmpty then
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case aValue.Kind of
|
||||||
|
tkInteger, tkInt64, tkEnumeration: Result := TDataValue.FromOrdinal(aValue.AsInt64);
|
||||||
|
tkFloat: Result := TDataValue.FromFloat(aValue.AsExtended);
|
||||||
|
tkString, tkUString: Result := TDataValue.FromText(aValue.AsString);
|
||||||
|
tkRecord:
|
||||||
|
begin
|
||||||
|
ctx := TRttiContext.Create;
|
||||||
|
var rttiRecordType := ctx.GetType(aValue.TypeInfo) as TRttiRecordType;
|
||||||
|
var recordDataType := DataTypeFromRttiType(ctx, rttiRecordType);
|
||||||
|
|
||||||
|
var items: TArray<IDataValue>;
|
||||||
|
var fields := rttiRecordType.GetFields;
|
||||||
|
SetLength(items, Length(fields));
|
||||||
|
var dataPtr := aValue.GetReferenceToRawData;
|
||||||
|
|
||||||
|
for var i := 0 to High(fields) do
|
||||||
|
items[i] := DataValueFromTValue(fields[i].GetValue(dataPtr));
|
||||||
|
|
||||||
|
Result := recordDataType.AsRecord.CreateValue(items);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
raise ENotSupportedException
|
||||||
|
.CreateFmt('Unsupported TValue Kind "%s" for indicator templates.', [GetEnumName(TypeInfo(TTypeKind), Ord(aValue.Kind))]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor IndicatorNameAttribute.Create(const AShortName, AName: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FShortName := AShortName;
|
||||||
|
FName := AName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor IndicatorHintAttribute.Create(const AHint: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FHint := AHint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TGenericIndicatorFactory }
|
||||||
|
|
||||||
|
constructor TGenericIndicatorFactory.Create(
|
||||||
|
const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
|
||||||
|
const AShortName, AName, AHint: String;
|
||||||
|
const AParamType, AArgType, AResultType: IDataType
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FFactoryProc := AFactoryProc;
|
||||||
|
FShortName := AShortName;
|
||||||
|
FName := AName;
|
||||||
|
FHint := AHint;
|
||||||
|
FParamType := AParamType;
|
||||||
|
FArgType := AArgType;
|
||||||
|
FResultType := AResultType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
|
||||||
|
var
|
||||||
|
Ctx: TRttiContext;
|
||||||
|
rttiType: TRttiType;
|
||||||
|
paramsDataType, argsDataType, resultDataType: IDataType;
|
||||||
|
templateFactoryMethod: TRttiMethod;
|
||||||
|
factoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
|
||||||
|
shortName, name, hint: string;
|
||||||
|
begin
|
||||||
|
// This function creates a generic factory from a template class.
|
||||||
|
// It uses RTTI to find the necessary types by inspecting the factory method signature,
|
||||||
|
// and then constructs a set of wrappers to adapt the specific types of the template
|
||||||
|
// to the generic IDataValue used by this factory.
|
||||||
|
Ctx := TRttiContext.Create;
|
||||||
|
rttiType := Ctx.GetType(TypeInfo(T));
|
||||||
|
|
||||||
|
// Find the static factory method marked with the [IndicatorFactory] attribute.
|
||||||
|
templateFactoryMethod := nil;
|
||||||
|
for var method in rttiType.GetMethods do
|
||||||
|
begin
|
||||||
|
if method.HasAttribute<IndicatorFactoryAttribute> then
|
||||||
|
begin
|
||||||
|
templateFactoryMethod := method;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if not Assigned(templateFactoryMethod) then
|
||||||
|
raise EArgumentException.CreateFmt('[IndicatorFactory] attribute not found on any method in "%s"', [rttiType.Name]);
|
||||||
|
|
||||||
|
// Ensure the found method has the expected signature of a TIndicatorFactoryProc<>.
|
||||||
|
// If any part of the signature check fails, raise an exception.
|
||||||
|
var returnType := templateFactoryMethod.ReturnType;
|
||||||
|
var rttiFactoryProcType, rttiIndicatorProcType: TRttiInterfaceType;
|
||||||
|
var factoryInvoke, indicatorInvoke: TRttiMethod;
|
||||||
|
|
||||||
|
try
|
||||||
|
// Level 1: Factory method signature
|
||||||
|
if not ((templateFactoryMethod.MethodKind in [mkFunction, mkClassFunction])
|
||||||
|
and (Length(templateFactoryMethod.GetParameters) = 0)
|
||||||
|
and Assigned(returnType)
|
||||||
|
and (returnType.TypeKind = tkInterface)) then
|
||||||
|
raise EArgumentException.Create('factory creator');
|
||||||
|
|
||||||
|
// Level 2: Factory procedure signature
|
||||||
|
rttiFactoryProcType := returnType as TRttiInterfaceType;
|
||||||
|
factoryInvoke := rttiFactoryProcType.GetMethod('Invoke');
|
||||||
|
if not (Assigned(factoryInvoke)
|
||||||
|
and (Length(factoryInvoke.GetParameters) = 1)
|
||||||
|
and (pfConst in factoryInvoke.GetParameters[0].Flags)
|
||||||
|
and (factoryInvoke.GetParameters[0].ParamType.TypeKind = tkRecord)
|
||||||
|
and Assigned(factoryInvoke.ReturnType)
|
||||||
|
and (factoryInvoke.ReturnType.TypeKind = tkInterface)) then
|
||||||
|
raise EArgumentException.Create('factory');
|
||||||
|
|
||||||
|
// Level 3: Indicator procedure signature
|
||||||
|
rttiIndicatorProcType := factoryInvoke.ReturnType as TRttiInterfaceType;
|
||||||
|
indicatorInvoke := rttiIndicatorProcType.GetMethod('Invoke');
|
||||||
|
if not (Assigned(indicatorInvoke)
|
||||||
|
and (Length(indicatorInvoke.GetParameters) = 1)
|
||||||
|
and (pfConst in indicatorInvoke.GetParameters[0].Flags)
|
||||||
|
and (indicatorInvoke.GetParameters[0].ParamType.TypeKind = tkRecord)
|
||||||
|
and Assigned(indicatorInvoke.ReturnType)
|
||||||
|
and (indicatorInvoke.ReturnType.TypeKind = tkRecord)) then
|
||||||
|
raise EArgumentException.Create('indicator');
|
||||||
|
except
|
||||||
|
on E: EArgumentException do
|
||||||
|
raise EArgumentException.CreateFmt(
|
||||||
|
'Method "%s" marked with [IndicatorFactory] has an invalid %s signature. It has to match TIndicatorFactoryProc<>.',
|
||||||
|
[templateFactoryMethod.ToString, E.Message]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Convert RTTI types to IDataType from our custom type system.
|
||||||
|
paramsDataType := DataTypeFromRttiType(Ctx, factoryInvoke.GetParameters[0].ParamType);
|
||||||
|
argsDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.GetParameters[0].ParamType);
|
||||||
|
resultDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.ReturnType);
|
||||||
|
|
||||||
|
// Extract metadata from attributes on the template type T.
|
||||||
|
shortName := '';
|
||||||
|
name := '';
|
||||||
|
hint := '';
|
||||||
|
for var attr in rttiType.GetAttributes do
|
||||||
|
begin
|
||||||
|
if attr is IndicatorNameAttribute then
|
||||||
|
begin
|
||||||
|
// Read properties from IndicatorNameAttribute.
|
||||||
|
var nameAttr := attr as IndicatorNameAttribute;
|
||||||
|
shortName := nameAttr.ShortName;
|
||||||
|
name := nameAttr.Name;
|
||||||
|
end
|
||||||
|
else if attr is IndicatorHintAttribute then
|
||||||
|
begin
|
||||||
|
// Read property from IndicatorHintAttribute.
|
||||||
|
var hintAttr := attr as IndicatorHintAttribute;
|
||||||
|
hint := hintAttr.Hint;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Apply default value for ShortName if it wasn't provided via attribute.
|
||||||
|
if shortName.IsEmpty then
|
||||||
|
begin
|
||||||
|
shortName := rttiType.Name;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Create the main factory procedure. This is a double-nested anonymous method
|
||||||
|
// that wraps the template's specific factory and worker functions.
|
||||||
|
factoryProc :=
|
||||||
|
function(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>
|
||||||
|
begin
|
||||||
|
// Outer anonymous method: This is the factory proc.
|
||||||
|
// It gets called with an IDataValue wrapping the parameters record.
|
||||||
|
|
||||||
|
// 1. Invoke the template's static factory method (e.g., TMyWorker.CreateFactory)
|
||||||
|
var factoryProcVal := templateFactoryMethod.Invoke(TValue.Empty, []);
|
||||||
|
|
||||||
|
// 2. Invoke the factory proc itself to get the actual worker proc.
|
||||||
|
var rttiFactoryProc := Ctx.GetType(factoryProcVal.TypeInfo) as TRttiInterfaceType;
|
||||||
|
var currentFactoryInvoke := rttiFactoryProc.GetMethod('Invoke');
|
||||||
|
|
||||||
|
// The parameter for this 'Invoke' call is the TParams record.
|
||||||
|
// Convert incoming IDataValue 'Params' into a TValue for the call.
|
||||||
|
var paramsAsTValue := Params.AsTValue;
|
||||||
|
|
||||||
|
// This call returns the worker proc (e.g., a TConvertFunc<TArgs, TResult>) as a TValue.
|
||||||
|
var workerProcVal := currentFactoryInvoke.Invoke(factoryProcVal, [paramsAsTValue]);
|
||||||
|
|
||||||
|
// 3. Return a new anonymous method that wraps the worker proc.
|
||||||
|
// This wrapper conforms to the generic TConvertFunc<IDataValue, IDataValue> signature.
|
||||||
|
var rttiWorkerProc := Ctx.GetType(workerProcVal.TypeInfo);
|
||||||
|
var currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke');
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
function(const Args: IDataValue): IDataValue
|
||||||
|
begin
|
||||||
|
// Inner anonymous method: This is the actual indicator proc wrapper.
|
||||||
|
// Convert input from IDataValue to TValue.
|
||||||
|
var argsAsTValue := Args.AsTValue;
|
||||||
|
|
||||||
|
// Invoke the actual indicator proc.
|
||||||
|
var resultAsTValue := currentIndicatorInvoke.Invoke(workerProcVal, [argsAsTValue]);
|
||||||
|
|
||||||
|
// Convert result from TValue back to IDataValue.
|
||||||
|
Result := DataValueFromTValue(resultAsTValue);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Create the final factory instance with all type handles and extracted metadata.
|
||||||
|
Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsDataType, argsDataType, resultDataType);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGenericIndicatorFactory.GetParamType: IDataType;
|
||||||
|
begin
|
||||||
|
Result := FParamType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGenericIndicatorFactory.GetArgType: IDataType;
|
||||||
|
begin
|
||||||
|
Result := FArgType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGenericIndicatorFactory.GetResultType: IDataType;
|
||||||
|
begin
|
||||||
|
Result := FResultType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGenericIndicatorFactory.CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>;
|
||||||
|
begin
|
||||||
|
Result := FFactoryProc(Params);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
|
||||||
|
begin
|
||||||
|
var paramsAsTValue := TValue.From<TParams>(Params);
|
||||||
|
var paramsAsDataValue := DataValueFromTValue(paramsAsTValue);
|
||||||
|
var cIndicator := FFactoryProc(paramsAsDataValue);
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
function(const Args: TArgs): TResult
|
||||||
|
begin
|
||||||
|
var argsAsTValue := TValue.From<TArgs>(Args);
|
||||||
|
var argsAsDataValue := DataValueFromTValue(argsAsTValue);
|
||||||
|
var resultAsDataValue := cIndicator(argsAsDataValue);
|
||||||
|
var resultAsTValue := resultAsDataValue.AsTValue;
|
||||||
|
Result := resultAsTValue.AsType<TResult>;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TIndicatorRegistry.TItem }
|
||||||
|
|
||||||
|
constructor TIndicatorRegistry.TItem.Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FFactory := AFactory;
|
||||||
|
FShortName := AShortName;
|
||||||
|
FName := AName;
|
||||||
|
FHint := AHint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIndicatorRegistry.TItem.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
|
||||||
|
begin
|
||||||
|
// Convert typed params to IDataValue for the factory call.
|
||||||
|
var paramsAsTValue := TValue.From<TParams>(Params);
|
||||||
|
var paramsAsDataValue := DataValueFromTValue(paramsAsTValue);
|
||||||
|
var cIndicator := FFactory.CreateIndicator(paramsAsDataValue);
|
||||||
|
|
||||||
|
// Return a wrapper that handles the conversion for args and result.
|
||||||
|
Result :=
|
||||||
|
function(const Args: TArgs): TResult
|
||||||
|
begin
|
||||||
|
var argsAsTValue := TValue.From<TArgs>(Args);
|
||||||
|
var argsAsDataValue := DataValueFromTValue(argsAsTValue);
|
||||||
|
var resultAsDataValue := cIndicator(argsAsDataValue);
|
||||||
|
var resultAsTValue := resultAsDataValue.AsTValue;
|
||||||
|
Result := resultAsTValue.AsType<TResult>;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TIndicatorRegistry }
|
||||||
|
|
||||||
|
constructor TIndicatorRegistry.Create;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FItems := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TIndicatorRegistry.Destroy;
|
||||||
|
var
|
||||||
|
item: TItem;
|
||||||
|
begin
|
||||||
|
for item in FItems do
|
||||||
|
item.Free;
|
||||||
|
FItems := nil;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIndicatorRegistry.Find(const ShortName: string): TIndicatorRegistry.TItem;
|
||||||
|
begin
|
||||||
|
for var item in FItems do
|
||||||
|
begin
|
||||||
|
if SameText(item.ShortName, ShortName) then
|
||||||
|
begin
|
||||||
|
Result := item;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIndicatorRegistry.LogRegistry(const Log: TStrings);
|
||||||
|
var
|
||||||
|
item: TItem;
|
||||||
|
|
||||||
|
// Generates a field layout from a data type.
|
||||||
|
function LayoutFromDataType(DataType: IDataType): TFieldLayout;
|
||||||
|
var
|
||||||
|
recordType: IDataRecordType;
|
||||||
|
begin
|
||||||
|
if (not Assigned(DataType)) or (DataType.Kind <> TDataKind.dkRecord) then
|
||||||
|
begin
|
||||||
|
SetLength(Result, 0);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
recordType := TDataType.Create(DataType).AsRecord;
|
||||||
|
SetLength(Result, recordType.FieldCount);
|
||||||
|
for var i := 0 to recordType.FieldCount - 1 do
|
||||||
|
begin
|
||||||
|
Result[i].Identifier := recordType[i].Name;
|
||||||
|
Result[i].DataType := recordType[i].DataType;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure DoLog(const Txt: String);
|
||||||
|
begin
|
||||||
|
Log.Add(Txt);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure LogLayout(const LayoutName: string; const Layout: TFieldLayout);
|
||||||
|
var
|
||||||
|
field: TFieldDef;
|
||||||
|
begin
|
||||||
|
DoLog(Format(' %s:', [LayoutName]));
|
||||||
|
if Length(Layout) = 0 then
|
||||||
|
begin
|
||||||
|
DoLog(' (none)');
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
for field in Layout do
|
||||||
|
DoLog(Format(' - %s: %s', [field.Identifier, field.DataType.Name]));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if not Assigned(Log) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
Log.Clear;
|
||||||
|
DoLog(Format('Indicator Registry Content (%d items)', [Length(FItems)]));
|
||||||
|
DoLog('==========================================');
|
||||||
|
DoLog('');
|
||||||
|
|
||||||
|
if Length(FItems) = 0 then
|
||||||
|
begin
|
||||||
|
DoLog('(Registry is empty)');
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
for item in FItems do
|
||||||
|
begin
|
||||||
|
DoLog(Format('Indicator "%s" (%s)', [item.Name, item.ShortName]));
|
||||||
|
if not item.Hint.IsEmpty then
|
||||||
|
DoLog(Format(' Hint: %s', [item.Hint]));
|
||||||
|
|
||||||
|
// Generate layouts on-the-fly from the factory's type info.
|
||||||
|
LogLayout('Params', LayoutFromDataType(item.Factory.ParamType));
|
||||||
|
LogLayout('Args', LayoutFromDataType(item.Factory.ArgType));
|
||||||
|
LogLayout('Result', LayoutFromDataType(item.Factory.ResultType));
|
||||||
|
DoLog('');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIndicatorRegistry.RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String);
|
||||||
|
var
|
||||||
|
item: TItem;
|
||||||
|
begin
|
||||||
|
if Assigned(Find(ShortName)) then
|
||||||
|
raise EArgumentException.CreateFmt('Indicator with ShortName "%s" is already registered.', [ShortName]);
|
||||||
|
|
||||||
|
// Create the registry item and add it to the list.
|
||||||
|
item := TItem.Create(Factory, ShortName, Name, Hint);
|
||||||
|
var i := Length(FItems);
|
||||||
|
SetLength(FItems, i + 1);
|
||||||
|
FItems[i] := item;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIndicatorRegistry.RegisterTemplate<TIndicatorTemplate>;
|
||||||
|
begin
|
||||||
|
// Create the factory object, which holds both the factory interface and the metadata properties.
|
||||||
|
var factory := TGenericIndicatorFactory.CreateFromTemplate<TIndicatorTemplate>;
|
||||||
|
// Pass the factory interface and the metadata properties to the core registration method.
|
||||||
|
RegisterIndicator(factory, factory.ShortName, factory.Name, factory.Hint);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
IndicatorRegistry := TIndicatorRegistry.Create;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
IndicatorRegistry.Free;
|
||||||
|
|
||||||
|
end.
|
||||||
Reference in New Issue
Block a user