2017-05-28 21:51:57 +00:00
unit LuaLEDFunctionProvider;
interface
uses
System. Generics. Collections,
System. SysUtils,
System. Types,
2017-06-04 09:18:48 +00:00
OtlTask,
OtlTaskControl,
2017-06-01 18:19:19 +00:00
X2Log. Intf,
2017-05-28 21:51:57 +00:00
LEDFunction,
LEDFunctionIntf,
LEDStateIntf,
Lua;
type
ELuaScriptError = class( Exception) ;
2017-06-10 08:01:00 +00:00
ELuaScriptLoadError = class( ELuaScriptError)
private
FFilename: string ;
public
constructor Create( const AMessage, AFilename: string ) ;
property Filename: string read FFilename;
end ;
2017-05-28 21:51:57 +00:00
TCustomLuaLEDFunctionWorker = class ;
TCustomLuaLEDFunction = class( TCustomMultiStateLEDFunction)
private
FCategoryName: string ;
FDisplayName: string ;
FUID: string ;
FScriptStates: ILuaTable;
FSetup: ILuaFunction;
protected
procedure RegisterStates; override ;
function GetDefaultCategoryName: string ; virtual ;
{ ILEDFunction }
function GetCategoryName: string ; override ;
function GetDisplayName: string ; override ;
function GetUID: string ; override ;
property ScriptStates: ILuaTable read FScriptStates;
property Setup: ILuaFunction read FSetup;
public
constructor Create( AProvider: ILEDFunctionProvider; AInfo: ILuaTable; ASetup: ILuaFunction) ;
end ;
TCustomLuaLEDFunctionProvider = class( TCustomLEDFunctionProvider)
private
FInterpreter: TLua;
FScriptFolders: TStringDynArray;
FWorkers: TDictionary< string , TCustomLuaLEDFunctionWorker> ;
2017-05-30 20:03:29 +00:00
FScriptLog: TObject;
2017-05-28 21:51:57 +00:00
protected
function CreateLuaLEDFunction( AInfo: ILuaTable; ASetup: ILuaFunction) : TCustomLuaLEDFunction; virtual ; abstract ;
2017-06-04 09:18:48 +00:00
procedure CheckParameters( const AFunctionName: string ; AParameters: ILuaReadParameters; AExpectedTypes: array of TLuaVariableType) ;
2017-06-01 18:19:19 +00:00
procedure AppendVariable( ABuilder: TStringBuilder; AVariable: ILuaVariable) ;
procedure AppendTable( ABuilder: TStringBuilder; ATable: ILuaTable) ;
procedure DoLog( AContext: ILuaContext; ALevel: TX2LogLevel) ;
procedure DoLogMessage( AContext: ILuaContext; ALevel: TX2LogLevel; const AMessage: string ) ;
2017-05-30 20:03:29 +00:00
procedure ScriptRegisterFunction( Context: ILuaContext) ;
procedure ScriptSetState( Context: ILuaContext) ;
2017-06-04 09:18:48 +00:00
procedure ScriptOnTimer( Context: ILuaContext) ;
procedure ScriptWindowVisible( Context: ILuaContext) ;
function WindowVisible( const AClassName, AWindowTitle, AParentClassName, AParentWindowTitle: string ) : Boolean ;
2017-05-30 20:03:29 +00:00
2017-05-28 21:51:57 +00:00
procedure InitInterpreter; virtual ;
procedure RegisterFunctions; override ;
procedure RegisterWorker( AWorker: TCustomLuaLEDFunctionWorker) ;
procedure UnregisterWorker( AWorker: TCustomLuaLEDFunctionWorker) ;
function FindWorker( const AUID: string ) : TCustomLuaLEDFunctionWorker;
property Interpreter: TLua read FInterpreter;
property ScriptFolders: TStringDynArray read FScriptFolders;
property Workers: TDictionary< string , TCustomLuaLEDFunctionWorker> read FWorkers;
public
constructor Create( const AScriptFolders: TStringDynArray) ;
destructor Destroy; override ;
end ;
TCustomLuaLEDFunctionWorker = class( TCustomLEDMultiStateFunctionWorker)
private
FProvider: TCustomLuaLEDFunctionProvider;
FUID: string ;
2017-06-04 09:18:48 +00:00
FTasks: TList< IOmniTaskControl> ;
2017-05-28 21:51:57 +00:00
procedure SetProvider( const Value: TCustomLuaLEDFunctionProvider) ;
protected
2017-06-04 09:18:48 +00:00
procedure AddTask( ATask: IOmniTaskControl) ;
2017-05-28 21:51:57 +00:00
property Provider: TCustomLuaLEDFunctionProvider read FProvider write SetProvider;
2017-06-04 09:18:48 +00:00
property Tasks: TList< IOmniTaskControl> read FTasks;
2017-05-28 21:51:57 +00:00
public
constructor Create( const AProviderUID, AFunctionUID: string ; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = '' ) ; override ;
destructor Destroy; override ;
property UID: string read FUID;
end ;
implementation
uses
2017-05-30 20:03:29 +00:00
System. Classes,
2017-05-28 21:51:57 +00:00
System. IOUtils,
2017-06-06 21:59:54 +00:00
System. Generics. Defaults,
System. Math,
2017-06-04 09:18:48 +00:00
System. StrUtils,
Winapi . Windows,
2017-05-28 21:51:57 +00:00
2017-05-30 20:03:29 +00:00
Lua. API,
X2Log. Global,
2017-05-28 21:51:57 +00:00
LEDColorIntf,
LEDState;
2017-05-30 20:03:29 +00:00
type
2017-06-01 18:19:19 +00:00
TLuaLogProc = reference to procedure( AContext: ILuaContext; ALevel: TX2LogLevel) ;
2017-05-30 20:03:29 +00:00
TLuaLog = class( TPersistent)
private
2017-06-01 18:19:19 +00:00
FOnLog: TLuaLogProc;
2017-05-30 20:03:29 +00:00
protected
2017-06-01 18:19:19 +00:00
property OnLog: TLuaLogProc read FOnLog;
2017-05-30 20:03:29 +00:00
public
2017-06-01 18:19:19 +00:00
constructor Create( AOnLog: TLuaLogProc) ;
2017-05-30 20:03:29 +00:00
published
procedure Verbose( Context: ILuaContext) ;
procedure Info( Context: ILuaContext) ;
procedure Warning( Context: ILuaContext) ;
procedure Error( Context: ILuaContext) ;
end ;
2017-06-04 09:18:48 +00:00
TLuaTimerTask = class( TOmniWorker)
private
FOnTimer: TProc;
protected
property OnTimer: TProc read FOnTimer;
public
constructor Create( AOnTimer: TProc) ;
procedure Run;
end ;
2017-05-28 21:51:57 +00:00
const
LuaLEDColors: array [ TLEDColor] of string =
(
'Off' , 'Green' , 'Amber' , 'Red' ,
'FlashingGreenFast' , 'FlashingGreenNormal' ,
'FlashingAmberFast' , 'FlashingAmberNormal' ,
'FlashingRedFast' , 'FlashingRedNormal'
) ;
2017-05-30 20:03:29 +00:00
2017-05-28 21:51:57 +00:00
function GetLEDColor( const AValue: string ; ADefault: TLEDColor = lcOff) : TLEDColor;
var
color: TLEDColor;
begin
for color : = Low( TLEDColor) to High( TLEDColor) do
if SameText( AValue, LuaLEDColors[ color] ) then
exit( color) ;
Result : = ADefault;
end ;
{ TCustomLuaLEDFunctionProvider }
constructor TCustomLuaLEDFunctionProvider. Create( const AScriptFolders: TStringDynArray) ;
begin
FWorkers : = TDictionary< string , TCustomLuaLEDFunctionWorker> . Create;
FInterpreter : = TLua. Create;
FScriptFolders : = AScriptFolders;
2017-06-01 18:19:19 +00:00
FScriptLog : = TLuaLog. Create( DoLog) ;
2017-05-28 21:51:57 +00:00
InitInterpreter;
inherited Create;
end ;
destructor TCustomLuaLEDFunctionProvider. Destroy;
begin
2017-06-01 18:19:19 +00:00
inherited Destroy;
2017-05-28 21:51:57 +00:00
FreeAndNil( FInterpreter) ;
2017-05-30 20:03:29 +00:00
FreeAndNil( FScriptLog) ;
2017-05-28 21:51:57 +00:00
FreeAndNil( FWorkers) ;
end ;
procedure TCustomLuaLEDFunctionProvider. InitInterpreter;
var
2017-06-04 09:18:48 +00:00
requirePath: TStringBuilder;
scriptFolder: string ;
2017-05-28 21:51:57 +00:00
table: ILuaTable;
color: TLEDColor;
begin
2017-06-04 09:18:48 +00:00
requirePath : = TStringBuilder. Create;
try
for scriptFolder in ScriptFolders do
begin
if requirePath. Length > 0 then
requirePath. Append( ';' ) ;
requirePath. Append( IncludeTrailingPathDelimiter( scriptFolder) ) . Append( '?;' )
. Append( IncludeTrailingPathDelimiter( scriptFolder) ) . Append( '?.lua' ) ;
end ;
Interpreter. SetRequirePath( requirePath. ToString) ;
Interpreter. GetRequirePath;
finally
FreeAndNil( requirePath) ;
end ;
2017-05-30 20:03:29 +00:00
Interpreter. RegisterFunction( 'RegisterFunction' , ScriptRegisterFunction) ;
Interpreter. RegisterFunction( 'SetState' , ScriptSetState) ;
2017-06-04 09:18:48 +00:00
Interpreter. RegisterFunction( 'OnTimer' , ScriptOnTimer) ;
Interpreter. RegisterFunction( 'WindowVisible' , ScriptWindowVisible) ;
2017-05-28 21:51:57 +00:00
2017-05-30 20:03:29 +00:00
Interpreter. RegisterFunctions( FScriptLog, 'Log' ) ;
2017-05-28 21:51:57 +00:00
2017-05-30 20:03:29 +00:00
table : = TLuaTable. Create;
for color : = Low( TLEDColor) to High( TLEDColor) do
table. SetValue( LuaLEDColors[ color] , LuaLEDColors[ color] ) ;
2017-05-28 21:51:57 +00:00
2017-05-30 20:03:29 +00:00
Interpreter. SetGlobalVariable( 'LEDColor' , table) ;
2017-06-04 09:18:48 +00:00
end ;
2017-05-28 21:51:57 +00:00
2017-06-04 09:18:48 +00:00
procedure TCustomLuaLEDFunctionProvider. CheckParameters( const AFunctionName: string ; AParameters: ILuaReadParameters; AExpectedTypes: array of TLuaVariableType) ;
const
VariableTypeName: array [ TLuaVariableType] of string =
(
'None' , 'Boolean' , 'Integer' ,
'Number' , 'UserData' , 'String' ,
'Table' , 'Function'
) ;
var
parameterIndex: Integer ;
begin
if AParameters. Count < Length( AExpectedTypes) then
raise ELuaScriptError. CreateFmt( '%s: expected at least %d parameter%s' , [ AFunctionName, Length( AExpectedTypes) , IfThen( Length( AExpectedTypes) < > 1 , 's' , '' ) ] ) ;
for parameterIndex : = 0 to High( AExpectedTypes) do
if AParameters[ parameterIndex] . VariableType < > AExpectedTypes[ parameterIndex] then
raise ELuaScriptError. CreateFmt( '%s: expected %s for parameter %d, got %s' ,
[ AFunctionName, VariableTypeName[ AExpectedTypes[ parameterIndex] ] ,
Succ( parameterIndex) , VariableTypeName[ AParameters[ parameterIndex] . VariableType] ] ) ;
2017-05-30 20:03:29 +00:00
end ;
2017-05-28 21:51:57 +00:00
2017-06-01 18:19:19 +00:00
procedure TCustomLuaLEDFunctionProvider. AppendVariable( ABuilder: TStringBuilder; AVariable: ILuaVariable) ;
begin
case AVariable. VariableType of
VariableBoolean:
if AVariable. AsBoolean then
ABuilder. Append( 'true' )
else
ABuilder. Append( 'false' ) ;
VariableTable:
AppendTable( ABuilder, AVariable. AsTable) ;
else
ABuilder. Append( AVariable. AsString) ;
end ;
end ;
procedure TCustomLuaLEDFunctionProvider. AppendTable( ABuilder: TStringBuilder; ATable: ILuaTable) ;
var
firstItem: Boolean ;
item: TLuaKeyValuePair;
begin
ABuilder. Append( '{ ' ) ;
firstItem : = True ;
for item in ATable do
begin
if firstItem then
firstItem : = False
else
ABuilder. Append( ', ' ) ;
AppendVariable( ABuilder, item. Key) ;
ABuilder. Append( ' = ' ) ;
AppendVariable( ABuilder, item. Value) ;
end ;
ABuilder. Append( ' }' ) ;
end ;
procedure TCustomLuaLEDFunctionProvider. DoLog( AContext: ILuaContext; ALevel: TX2LogLevel) ;
var
msg: TStringBuilder;
parameter: ILuaVariable;
begin
msg : = TStringBuilder. Create;
try
for parameter in AContext. Parameters do
begin
AppendVariable( msg, parameter) ;
msg. Append( ' ' ) ;
end ;
DoLogMessage( AContext, ALevel, msg. ToString) ;
finally
FreeAndNil( msg) ;
end ;
end ;
procedure TCustomLuaLEDFunctionProvider. DoLogMessage( AContext: ILuaContext; ALevel: TX2LogLevel; const AMessage: string ) ;
var
debug: lua_Debug;
fileName: string ;
begin
fileName : = 'Lua' ;
if Interpreter. HasState and ( lua_getstack( Interpreter. State, 1 , debug) < > 0 ) then
begin
lua_getinfo( Interpreter. State, 'Sl' , debug) ;
fileName : = fileName + ' - ' + string( debug. source)
end ;
TX2GlobalLog. Log( ALevel, AMessage, filename) ;
end ;
2017-05-30 20:03:29 +00:00
procedure TCustomLuaLEDFunctionProvider. ScriptRegisterFunction( Context: ILuaContext) ;
var
info: ILuaTable;
setup: ILuaFunction;
2017-05-28 21:51:57 +00:00
2017-05-30 20:03:29 +00:00
begin
2017-06-04 09:18:48 +00:00
CheckParameters( 'RegisterFunction' , Context. Parameters, [ VariableTable, VariableFunction] ) ;
2017-05-30 20:03:29 +00:00
info : = Context. Parameters[ 0 ] . AsTable;
setup : = Context. Parameters[ 1 ] . AsFunction;
2017-05-28 21:51:57 +00:00
2017-05-30 20:03:29 +00:00
if not info. HasValue( 'uid' ) then
2017-06-04 09:18:48 +00:00
raise ELuaScriptError. Create( 'RegisterFunction: "uid" value is required' ) ;
2017-05-30 20:03:29 +00:00
2017-06-01 18:19:19 +00:00
DoLogMessage( Context, TX2LogLevel. Info, Format( 'Registering function: %s' , [ info. GetValue( 'uid' ) . AsString] ) ) ;
2017-05-30 20:03:29 +00:00
RegisterFunction( CreateLuaLEDFunction( info, setup) ) ;
end ;
procedure TCustomLuaLEDFunctionProvider. ScriptSetState( Context: ILuaContext) ;
var
workerID: string ;
worker: TCustomLuaLEDFunctionWorker;
stateUID: string ;
begin
2017-06-04 09:18:48 +00:00
CheckParameters( 'SetState' , Context. Parameters, [ VariableString, VariableString] ) ;
2017-05-30 20:03:29 +00:00
workerID : = Context. Parameters[ 0 ] . AsString;
stateUID : = Context. Parameters[ 1 ] . AsString;
worker : = FindWorker( workerID) ;
if not Assigned( worker) then
2017-06-04 09:18:48 +00:00
raise ELuaScriptError. Create( 'SetState: invalid context' ) ;
2017-05-30 20:03:29 +00:00
2017-06-01 18:19:19 +00:00
DoLogMessage( Context, TX2LogLevel. Info, Format( 'Setting state for %s to: %s' , [ worker. GetFunctionUID, stateUID] ) ) ;
2017-05-30 20:03:29 +00:00
worker. SetCurrentState( stateUID) ;
2017-05-28 21:51:57 +00:00
end ;
2017-06-04 09:18:48 +00:00
procedure TCustomLuaLEDFunctionProvider. ScriptOnTimer( Context: ILuaContext) ;
var
workerID: string ;
interval: Integer ;
timerCallback: ILuaFunction;
worker: TCustomLuaLEDFunctionWorker;
begin
CheckParameters( 'OnTimer' , Context. Parameters, [ VariableString, VariableNumber, VariableFunction] ) ;
workerID : = Context. Parameters[ 0 ] . AsString;
interval : = Context. Parameters[ 1 ] . AsInteger;
timerCallback : = Context. Parameters[ 2 ] . AsFunction;
worker : = FindWorker( workerID) ;
if not Assigned( worker) then
raise ELuaScriptError. Create( 'OnTimer: invalid context' ) ;
DoLogMessage( Context, TX2LogLevel. Info, Format( 'Adding timer for %s, interval: %d' , [ worker. GetFunctionUID, interval] ) ) ;
worker. AddTask( CreateTask( TLuaTimerTask. Create(
procedure
begin
try
timerCallback. Call( [ workerID] ) ;
except
on E: Exception do
TX2GlobalLog. Category( 'Lua' ) . Exception( E) ;
end ;
end ) )
. SetTimer( 1 , MSecsPerSec, @ TLuaTimerTask. Run)
. Run) ;
end ;
procedure TCustomLuaLEDFunctionProvider. ScriptWindowVisible( Context: ILuaContext) ;
var
className: string ;
windowTitle: string ;
parentClassName: string ;
parentWindowTitle: string ;
begin
if Context. Parameters. Count = 0 then
raise ELuaScriptError. Create( 'WindowVisible: expected at least 1 parameter' ) ;
className : = '' ;
windowTitle : = '' ;
parentClassName : = '' ;
parentWindowTitle : = '' ;
if Context. Parameters. Count > = 1 then className : = Context. Parameters[ 0 ] . AsString;
if Context. Parameters. Count > = 2 then windowTitle : = Context. Parameters[ 1 ] . AsString;
if Context. Parameters. Count > = 3 then parentClassName : = Context. Parameters[ 2 ] . AsString;
if Context. Parameters. Count > = 4 then parentWindowTitle : = Context. Parameters[ 3 ] . AsString;
Context. Result . Push( WindowVisible( className, windowTitle, parentClassName, parentWindowTitle) ) ;
end ;
function TCustomLuaLEDFunctionProvider. WindowVisible( const AClassName, AWindowTitle, AParentClassName, AParentWindowTitle: string ) : Boolean ;
function GetNilPChar( const AValue: string ) : PChar ;
begin
if Length( AValue) > 0 then
Result : = PChar( AValue)
else
Result : = nil ;
end ;
var
parentWindow: THandle;
childWindow: THandle;
window: THandle;
begin
Result : = False ;
if ( Length( AParentClassName) > 0 ) or ( Length( AParentWindowTitle) > 0 ) then
begin
parentWindow : = FindWindow( GetNilPChar( AParentClassName) , GetNilPChar( AParentWindowTitle) ) ;
if parentWindow < > 0 then
begin
childWindow : = FindWindowEx( parentWindow, 0 , GetNilPChar( AClassName) , GetNilPChar( AWindowTitle) ) ;
Result : = ( childWindow < > 0 ) and IsWindowVisible( childWindow) ;
end ;
end else
begin
window : = FindWindow( GetNilPChar( AClassName) , GetNilPChar( AWindowTitle) ) ;
Result : = ( window < > 0 ) and IsWindowVisible( window) ;
end ;
end ;
2017-05-28 21:51:57 +00:00
procedure TCustomLuaLEDFunctionProvider. RegisterFunctions;
var
scriptFolder: string ;
scriptFile: string ;
begin
for scriptFolder in ScriptFolders do
2017-06-10 08:07:09 +00:00
if ForceDirectories( scriptFolder) then
2017-05-28 21:51:57 +00:00
for scriptFile in TDirectory. GetFiles( ScriptFolder, '*.lua' ) do
try
Interpreter. LoadFromFile( scriptFile) ;
except
on E: Exception do
2017-06-10 08:01:00 +00:00
Exception. RaiseOuterException( ELuaScriptLoadError. Create( E. Message , scriptFile) ) ;
2017-05-28 21:51:57 +00:00
end ;
end ;
procedure TCustomLuaLEDFunctionProvider. RegisterWorker( AWorker: TCustomLuaLEDFunctionWorker) ;
begin
Workers. Add( AWorker. UID, AWorker) ;
end ;
procedure TCustomLuaLEDFunctionProvider. UnregisterWorker( AWorker: TCustomLuaLEDFunctionWorker) ;
begin
Workers. Remove( AWorker. UID) ;
end ;
function TCustomLuaLEDFunctionProvider. FindWorker( const AUID: string ) : TCustomLuaLEDFunctionWorker;
begin
if not Workers. TryGetValue( AUID, Result ) then
Result : = nil ;
end ;
{ TCustomLuaLEDFunction }
constructor TCustomLuaLEDFunction. Create( AProvider: ILEDFunctionProvider; AInfo: ILuaTable; ASetup: ILuaFunction) ;
begin
FCategoryName : = GetDefaultCategoryName;
FDisplayName : = 'Unknown function' ;
FSetup : = ASetup;
FUID : = AInfo. GetValue( 'uid' ) . AsString;
if AInfo. HasValue( 'category' ) then
FCategoryName : = AInfo. GetValue( 'category' ) . AsString;
if AInfo. HasValue( 'displayName' ) then
FDisplayName : = AInfo. GetValue( 'displayName' ) . AsString;
FScriptStates : = nil ;
if AInfo. HasValue( 'states' ) then
FScriptStates : = AInfo. GetValue( 'states' ) . AsTable;
// #ToDo1 -oMvR: 28-5-2017: application filter?
inherited Create( AProvider. GetUID) ;
end ;
function TCustomLuaLEDFunction. GetCategoryName: string ;
begin
Result : = FCategoryName;
end ;
function TCustomLuaLEDFunction. GetDisplayName: string ;
begin
Result : = FDisplayName;
end ;
function TCustomLuaLEDFunction. GetUID: string ;
begin
Result : = FUID;
end ;
procedure TCustomLuaLEDFunction. RegisterStates;
2017-06-06 21:59:54 +00:00
type
TOrderedLEDState = record
Order: Integer ;
State: ILEDState;
end ;
2017-05-28 21:51:57 +00:00
var
2017-06-06 21:59:54 +00:00
states: TList< TOrderedLEDState> ;
scriptState: TLuaKeyValuePair;
2017-05-28 21:51:57 +00:00
displayName: string ;
defaultColor: TLEDColor;
info: ILuaTable;
2017-06-06 21:59:54 +00:00
state: TOrderedLEDState;
2017-05-28 21:51:57 +00:00
begin
if not Assigned( ScriptStates) then
exit;
2017-06-06 21:59:54 +00:00
states : = TList< TOrderedLEDState> . Create;
try
for scriptState in ScriptStates do
2017-05-28 21:51:57 +00:00
begin
2017-06-06 21:59:54 +00:00
state. Order : = 0 ;
displayName : = scriptState. Key. AsString;
defaultColor : = lcOff;
2017-05-28 21:51:57 +00:00
2017-06-06 21:59:54 +00:00
if scriptState. Value. VariableType = VariableTable then
begin
info : = scriptState. Value. AsTable;
if info. HasValue( 'displayName' ) then
displayName : = info. GetValue( 'displayName' ) . AsString;
if info. HasValue( 'default' ) then
defaultColor : = GetLEDColor( info. GetValue( 'default' ) . AsString) ;
if info. HasValue( 'order' ) then
state. Order : = info. GetValue( 'order' ) . AsInteger;
end ;
state. State : = TLEDState. Create( scriptState. Key. AsString, displayName, defaultColor) ;
states. Add( state)
2017-05-28 21:51:57 +00:00
end ;
2017-06-06 21:59:54 +00:00
states. Sort( TDelegatedComparer< TOrderedLEDState> . Create(
function( const Left, Right: TOrderedLEDState) : Integer
begin
Result : = CompareValue( Left. Order, Right. Order) ;
if Result = 0 then
Result : = CompareText( Left. State. GetDisplayName, Right. State. GetDisplayName) ;
end ) ) ;
for state in states do
RegisterState( state. State) ;
finally
FreeAndNil( states) ;
2017-05-28 21:51:57 +00:00
end ;
end ;
function TCustomLuaLEDFunction. GetDefaultCategoryName: string ;
begin
Result : = 'Other' ;
end ;
{ TCustomLuaLEDFunctionWorker }
constructor TCustomLuaLEDFunctionWorker. Create( const AProviderUID, AFunctionUID: string ; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string ) ;
var
workerGUID: TGUID;
begin
if CreateGUID( workerGUID) < > 0 then
RaiseLastOSError;
FUID : = GUIDToString( workerGUID) ;
inherited Create( AProviderUID, AFunctionUID, AStates, ASettings, APreviousState) ;
end ;
destructor TCustomLuaLEDFunctionWorker. Destroy;
2017-06-04 09:18:48 +00:00
var
task: IOmniTaskControl;
2017-05-28 21:51:57 +00:00
begin
2017-06-04 09:18:48 +00:00
if Assigned( Tasks) then
begin
for task in Tasks do
begin
task. Stop;
task. WaitFor( INFINITE) ;
end ;
FreeAndNil( FTasks) ;
end ;
2017-05-28 21:51:57 +00:00
SetProvider( nil ) ;
inherited Destroy;
end ;
2017-06-04 09:18:48 +00:00
procedure TCustomLuaLEDFunctionWorker. AddTask( ATask: IOmniTaskControl) ;
begin
if not Assigned( Tasks) then
FTasks : = TList< IOmniTaskControl> . Create;
Tasks. Add( ATask) ;
end ;
2017-05-28 21:51:57 +00:00
procedure TCustomLuaLEDFunctionWorker. SetProvider( const Value: TCustomLuaLEDFunctionProvider) ;
begin
if Value < > FProvider then
begin
if Assigned( FProvider) then
FProvider. UnregisterWorker( Self) ;
FProvider : = Value;
if Assigned( FProvider) then
FProvider. RegisterWorker( Self) ;
end ;
end ;
2017-05-30 20:03:29 +00:00
{ TLuaLog }
2017-06-01 18:19:19 +00:00
constructor TLuaLog. Create( AOnLog: TLuaLogProc) ;
2017-05-30 20:03:29 +00:00
begin
inherited Create;
2017-06-01 18:19:19 +00:00
FOnLog : = AOnLog;
2017-05-30 20:03:29 +00:00
end ;
procedure TLuaLog. Verbose( Context: ILuaContext) ;
begin
2017-06-01 18:19:19 +00:00
OnLog( Context, TX2LogLevel. Verbose) ;
2017-05-30 20:03:29 +00:00
end ;
procedure TLuaLog. Info( Context: ILuaContext) ;
begin
2017-06-01 18:19:19 +00:00
OnLog( Context, TX2LogLevel. Info) ;
2017-05-30 20:03:29 +00:00
end ;
procedure TLuaLog. Warning( Context: ILuaContext) ;
begin
2017-06-01 18:19:19 +00:00
OnLog( Context, TX2LogLevel. Warning) ;
2017-05-30 20:03:29 +00:00
end ;
procedure TLuaLog. Error( Context: ILuaContext) ;
begin
2017-06-01 18:19:19 +00:00
OnLog( Context, TX2LogLevel. Error) ;
2017-05-30 20:03:29 +00:00
end ;
2017-06-04 09:18:48 +00:00
{ TLuaTimerTask }
constructor TLuaTimerTask. Create( AOnTimer: TProc) ;
begin
inherited Create;
FOnTimer : = AOnTimer;
end ;
procedure TLuaTimerTask. Run;
begin
FOnTimer( ) ;
end ;
2017-06-10 08:01:00 +00:00
{ ELuaScriptLoadError }
constructor ELuaScriptLoadError. Create( const AMessage, AFilename: string ) ;
begin
inherited Create( AMessage) ;
FFilename : = AFilename;
end ;
2017-05-28 21:51:57 +00:00
end .