From 6183f771c95d3b03bdce1cdfc06f26450abb3441 Mon Sep 17 00:00:00 2001 From: Raymond Date: Sat, 10 Apr 2010 14:34:24 +0200 Subject: [PATCH] Added script property SP_OnTerminate.. This way you can add functions to a OnTerminate event list, these functions will be called at the end of the script. --- Units/MMLAddon/PSInc/Wrappers/other.inc | 4 +- Units/MMLAddon/PSInc/pscompile.inc | 2 +- Units/MMLAddon/PSInc/psexportedmethods.inc | 4 +- Units/MMLAddon/mmlpsthread.pas | 22 +++++ Units/MMLAddon/scriptproperties.pas | 94 ++++++++++++++++------ 5 files changed, 96 insertions(+), 30 deletions(-) diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc index 884637f..be0b32d 100644 --- a/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -21,12 +21,12 @@ Other.inc for the Mufasa Macro Library } -function ps_SetScriptProp(prop : TSP_Property; Value: String): boolean; extdecl; +function ps_SetScriptProp(prop : TSP_Property; Value: TVariantArray): boolean; extdecl; begin Exit(CurrThread.Prop.SetProp(prop, Value)); end; -function ps_GetScriptProp(prop : TSP_Property; var Value : string) : boolean; extdecl; +function ps_GetScriptProp(prop : TSP_Property; var Value : TVariantArray) : boolean; extdecl; begin; exit(CurrThread.Prop.GetProp(prop,value)); end; diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index e203337..9ed8272 100644 --- a/Units/MMLAddon/PSInc/pscompile.inc +++ b/Units/MMLAddon/PSInc/pscompile.inc @@ -56,7 +56,7 @@ Sender.Comp.AddTypeS('TStringArray','Array of string;'); Sender.Comp.AddTypeS('TMousePress', '(mouse_Down, mouse_Up);'); Sender.Comp.AddTypeS('Pointer', 'Integer'); -Sender.Comp.AddTypeS('TSP_Property','(SP_WriteTimeStamp)'); +Sender.Comp.AddTypeS('TSP_Property','(SP_WriteTimeStamp,SP_OnTerminate)'); Sender.Comp.AddConstantN('mouse_Right','integer').SetInt(ps_mouse_right); //0 diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index b8cb4db..a444f17 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -129,8 +129,8 @@ AddFunction(@ps_Random,'function Random(Int: integer): integer;'); AddFunction(@ps_ClearDebug,'procedure ClearDebug;'); AddFunction(@ps_PlaySound,'procedure PlaySound( Sound : string);'); AddFunction(@ps_StopSound,'procedure StopSound;'); -AddFunction(@ps_SetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: String): boolean;'); -AddFunction(@ps_GetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: String): boolean;'); +AddFunction(@ps_SetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: TVariantArray): boolean;'); +AddFunction(@ps_GetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: TVariantArray): boolean;'); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index cac484c..5c64684 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -131,6 +131,8 @@ type property OpenFileEvent : TOpenFileEvent read FOpenFileEvent write SetOpenFileEvent; end; + { TPSThread } + TPSThread = class(TMThread) public procedure OnProcessDirective(Sender: TPSPreProcessor; @@ -150,6 +152,7 @@ type procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler); procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); procedure OutputMessages; + procedure HandleScriptTerminates; public PSScript : TPSScript; constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); @@ -801,6 +804,22 @@ begin end; end; +procedure TPSThread.HandleScriptTerminates; +var + I : integer; +begin + if (PSScript.Exec.ExceptionCode =ErNoError) and (SP_OnTerminate in Prop.Properties) then + begin; + for i := 0 to Prop.OnTerminateProcs.Count - 1 do + begin + try + PSScript.ExecuteFunction([],Prop.OnTerminateProcs[i]); + finally + end; + end; + end; +end; + procedure TPSThread.Execute; begin CurrThread := Self; @@ -818,7 +837,10 @@ begin HandleError(PSScript.ExecErrorRow,PSScript.ExecErrorCol,PSScript.ExecErrorPosition,PSScript.ExecErrorToString, errRuntime, PSScript.ExecErrorFileName) else + begin + HandleScriptTerminates; psWriteln('Successfully executed.'); + end; end else begin OutputMessages; diff --git a/Units/MMLAddon/scriptproperties.pas b/Units/MMLAddon/scriptproperties.pas index 848a5a8..9d96508 100644 --- a/Units/MMLAddon/scriptproperties.pas +++ b/Units/MMLAddon/scriptproperties.pas @@ -5,13 +5,14 @@ unit scriptproperties; interface uses - Classes, SysUtils; + Classes, SysUtils,MufasaTypes,mufasabase; type { TScriptProperties } TSP_Property = ( - SP_WriteTimeStamp //Writes the time infront of a writeln + SP_WriteTimeStamp, //Writes the time infront of a writeln + SP_OnTerminate ); TSP_Properties = set of TSP_Property; @@ -19,40 +20,50 @@ type TScriptProperties = class(TObject) private FProperties : TSP_Properties; - FWriteTimeStamp : boolean; + FOnTerminateProcs : TStringList; + function HasTimeStamp: boolean; public constructor Create; destructor Destroy; override; function GetProperty(name: ansistring; var Prop : TSP_Property): boolean; - function GetProp(name: ansistring; var Value : ansistring) : Boolean;overload; - function GetProp(Prop : TSP_Property; var Value : ansistring) : Boolean;overload; - function SetProp(Name: ansistring; Value: ansistring): Boolean;overload; - function SetProp(Prop : TSP_Property; Value: ansistring): Boolean;overload; + function GetProp(name: ansistring; var Value : TVariantArray) : Boolean;overload; + function GetProp(Prop : TSP_Property; var Value : TVariantArray) : Boolean;overload; + function SetProp(Name: ansistring; Value: TVariantArray): Boolean;overload; + function SetProp(Prop : TSP_Property; Value: TVariantArray): Boolean;overload; public - property WriteTimeStamp : boolean read FWriteTimeStamp; + property Properties : TSP_Properties read FProperties; + property WriteTimeStamp : boolean read HasTimeStamp; + property OnTerminateProcs : TStringList read FOnTerminateProcs; end; implementation +function TScriptProperties.HasTimeStamp: boolean; +begin + result := (SP_WriteTimeStamp in FProperties); +end; + constructor TScriptProperties.Create; begin inherited; - FWriteTimeStamp := False; FProperties := []; - + FOnTerminateProcs := TStringList.Create; + FOnTerminateProcs.CaseSensitive:= false; + FOnTerminateProcs.Duplicates:= dupIgnore; { set default values } end; destructor TScriptProperties.Destroy; begin + FOnTerminateProcs.Free; inherited Destroy; end; function TScriptProperties.GetProperty(name: ansistring; var Prop : TSP_Property): boolean; const - Names : array[TSP_Property] of ansistring = ('writetimestamp'); + Names : array[TSP_Property] of ansistring = ('writetimestamp','onterminate'); var i : integer; begin @@ -65,7 +76,7 @@ begin end; end; -function TScriptProperties.GetProp(name: ansistring; var Value: ansistring): Boolean; +function TScriptProperties.GetProp(name: ansistring; var Value: TVariantArray): Boolean; var Prop : TSP_Property; begin @@ -74,16 +85,28 @@ begin Result := (GetProp(Prop,value)); end; -function TScriptProperties.GetProp(Prop: TSP_Property; var Value: ansistring +function TScriptProperties.GetProp(Prop: TSP_Property; var Value: TVariantArray ): Boolean; +var + i : integer; begin Result := true; + Setlength(value,0); case Prop of - SP_WriteTimeStamp : Value := BoolToStr(Prop in FProperties,true); + SP_WriteTimeStamp : begin SetLength(Value,1); Value[0] := BoolToStr(Prop in FProperties,true); end; + SP_OnTerminate : + begin + if not (Prop in FProperties) then + exit; + setlength(value,FOnTerminateProcs.Count); + for i := 0 to high(Value) do + value[i] := FOnTerminateProcs[i]; + result := true; + end; end; end; -function TScriptProperties.SetProp(Name: ansistring; Value: ansistring): Boolean; +function TScriptProperties.SetProp(Name: ansistring; Value: TVariantArray): Boolean; var Prop : TSP_Property; begin @@ -92,18 +115,39 @@ begin Result := (SetProp(Prop,value)); end; -function TScriptProperties.SetProp(Prop: TSP_Property; Value: ansistring): Boolean; +function TScriptProperties.SetProp(Prop: TSP_Property; Value: TVariantArray): Boolean; +var + i : integer; begin + result := false; + if Length(value) < 1 then + begin; + mDebugLn('SetProp passed a TVarArray with a length of 0' ); + exit; + end; case Prop of - SP_WriteTimeStamp : if lowercase(value) = 'true' then - begin - FWriteTimeStamp:= True; - FProperties := FProperties + [Prop]; - end else - begin - FWriteTimeStamp := False; - FProperties := FProperties - [Prop]; - end; + SP_WriteTimeStamp : begin + if length(Value) <> 1 then + begin + mDebugLn('SP_WriteTimeStamp only needs 1 value in the array'); + exit; + end; + try + if Value[0] = True then + FProperties := FProperties + [Prop] + else + FProperties := FProperties - [Prop]; + except + mDebugLn('Could not convert your value passed to SetProp'); + end; + end; + SP_OnTerminate : + begin + for i := 0 to high(value) do + FOnTerminateProcs.Add(Value[i]); + FProperties := FProperties + [prop]; + Result := True; + end; end; end;