unit Myc.Trade.Indicators_V2 deprecated; interface {$M+} uses System.TypInfo, System.Rtti, Myc.Data.Pipeline, Myc.Data.Types, Myc.Data.Types.RTTI, System.Classes; type TIndicatorFactoryProc = reference to function(const Params: TParams): TConvertFunc; (* 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; static; // Hard coded version: class function CreateHMA( Period: Integer ): TConvertFunc; 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: TDataType; end; TFieldLayout = TArray; // Interface for creating an indicator instance. Only contains functional aspects. IIndicatorFactory = interface function GetParamType: TDataType; function GetArgType: TDataType; function GetResultType: TDataType; function CreateIndicator(const Params: TDataType.TValue): TConvertFunc; // Provides direct access to the type information of parameters, arguments, and results. property ParamType: TDataType read GetParamType; property ArgType: TDataType read GetArgType; property ResultType: TDataType read GetResultType; end; TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory) private FFactoryProc: TIndicatorFactoryProc; FName: String; FShortName: String; FHint: String; FParamType: TDataType; FArgType: TDataType; FResultType: TDataType; public constructor Create( const AFactoryProc: TIndicatorFactoryProc; const AShortName, AName, AHint: String; const AParamType, AArgType, AResultType: TDataType ); // IIndicatorFactory function GetParamType: TDataType; function GetArgType: TDataType; function GetResultType: TDataType; function CreateIndicator(const Params: TDataType.TValue): TConvertFunc; overload; class function CreateFromTemplate: TGenericIndicatorFactory; function CreateIndicator(const Params: TParams): TConvertFunc; 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(const Params: TParams): TConvertFunc; 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; 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; // 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 read FItems; end; var IndicatorRegistry: TIndicatorRegistry; function DataValueFromTValue(const aValue: TValue): TDataType.TValue; 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 := TDataType.Void; 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.Create(); for var rttiField in rttiRecord.GetFields do begin var fieldType := DataTypeFromRttiType(Ctx, rttiField.FieldType); recordFields := recordFields + [TDataRecordField.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): TDataType.TValue; var ctx: TRttiContext; begin if aValue.IsEmpty then begin Result := TDataType.TValue.Create(nil); exit; end; case aValue.Kind of tkInteger, tkInt64, tkEnumeration: Result := TDataType.Ordinal.CreateValue(aValue.AsInt64); tkFloat: Result := TDataType.Float.CreateValue(aValue.AsExtended); tkString, tkUString: Result := TDataType.Text.CreateValue(aValue.AsString); tkRecord: begin ctx := TRttiContext.Create; var rttiRecordType := ctx.GetType(aValue.TypeInfo) as TRttiRecordType; var recordDataType := DataTypeFromRttiType(ctx, rttiRecordType); var items: TArray; 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; const AShortName, AName, AHint: String; const AParamType, AArgType, AResultType: TDataType ); begin inherited Create; FFactoryProc := AFactoryProc; FShortName := AShortName; FName := AName; FHint := AHint; FParamType := AParamType; FArgType := AArgType; FResultType := AResultType; end; class function TGenericIndicatorFactory.CreateFromTemplate: TGenericIndicatorFactory; var Ctx: TRttiContext; rttiType: TRttiType; paramsDataType, argsDataType, resultDataType: TDataType; templateFactoryMethod: TRttiMethod; factoryProc: TIndicatorFactoryProc; 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 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 TDataType 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: TDataType.TValue): TConvertFunc 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) 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 signature. var rttiWorkerProc := Ctx.GetType(workerProcVal.TypeInfo); var currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke'); Result := function(const Args: TDataType.TValue): TDataType.TValue 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: TDataType; begin Result := FParamType; end; function TGenericIndicatorFactory.GetArgType: TDataType; begin Result := FArgType; end; function TGenericIndicatorFactory.GetResultType: TDataType; begin Result := FResultType; end; function TGenericIndicatorFactory.CreateIndicator(const Params: TDataType.TValue): TConvertFunc; var internalProc: TConvertFunc; begin internalProc := FFactoryProc(Params); Result := function(const Args: TDataType.TValue): TDataType.TValue begin Result := internalProc(Args); end; end; function TGenericIndicatorFactory.CreateIndicator(const Params: TParams): TConvertFunc; begin var paramsAsTValue := TValue.From(Params); var paramsAsDataValue := DataValueFromTValue(paramsAsTValue); var cIndicator := FFactoryProc(paramsAsDataValue); { Result := function(const Args: TArgs): TResult begin var argsAsTValue := TValue.From(Args); var argsAsDataValue := DataValueFromTValue(argsAsTValue); var resultAsDataValue := cIndicator(argsAsDataValue); var resultAsTValue := resultAsDataValue.AsTValue; Result := resultAsTValue.AsType; 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(const Params: TParams): TConvertFunc; begin // Convert typed params to IDataValue for the factory call. var paramsAsTValue := TValue.From(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(Args); var argsAsDataValue := DataValueFromTValue(argsAsTValue); var resultAsDataValue := cIndicator(argsAsDataValue); var resultAsTValue := resultAsDataValue.AsTValue; Result := resultAsTValue.AsType; 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: TDataType): TFieldLayout; var recordType: TDataType.TRecord; begin if DataType.Kind <> TDataKind.dkRecord then begin SetLength(Result, 0); exit; end; recordType := 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; begin // Create the factory object, which holds both the factory interface and the metadata properties. var factory := TGenericIndicatorFactory.CreateFromTemplate; // 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.