From 4b4ed038dfb174349777169ab5bbf4cfe5a13939 Mon Sep 17 00:00:00 2001 From: Olly Date: Sun, 13 Aug 2023 00:52:41 +0100 Subject: [PATCH] TTarget.AddOnInvalidTargetEvent --- .../imports/simba/simba.import_target.pas | 24 ++++--- Source/simba.target.pas | 69 +++++++------------ 2 files changed, 39 insertions(+), 54 deletions(-) diff --git a/Source/script/imports/simba/simba.import_target.pas b/Source/script/imports/simba/simba.import_target.pas index 96288b681..98ce76948 100644 --- a/Source/script/imports/simba/simba.import_target.pas +++ b/Source/script/imports/simba/simba.import_target.pas @@ -221,7 +221,7 @@ procedure _LapeTarget_ClearCustomClientArea(const Params: PParamArray); LAPE_WRA ``` Target.SetCustomClientArea([100,100,600,600]); -Input.MouseMove([1,1]); // Will move the mouse to [101,101] +Input.MouseMove([1,1]); // Will move the mouse to [101,101] on the "real" bounds ``` *) procedure _LapeTarget_SetCustomClientArea(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV @@ -264,9 +264,9 @@ procedure _LapeTarget_GetAutoFocus(const Params: PParamArray; const Result: Poin ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > function TTarget.AddHandlerOnInvalidTarget(Event: TInvalidTargetEvent): TInvalidTargetEvent; *) -procedure _LapeTarget_AddHandlerOnInvalidTarget(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeTarget_AddOnInvalidTargetEvent(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - TSimbaTarget.PInvalidTargetEvent(Result)^ := PSimbaTarget(Params^[0])^.AddHandlerOnInvalidTarget(TSimbaTarget.PInvalidTargetEvent(Params^[1])^); + TSimbaTarget.TInvalidTargetEvent(Result^) := PSimbaTarget(Params^[0])^.AddOnInvalidTargetEvent(TSimbaTarget.TInvalidTargetEvent(Params^[1]^)); end; (* @@ -274,9 +274,9 @@ procedure _LapeTarget_AddHandlerOnInvalidTarget(const Params: PParamArray; const ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > procedure TTarget.RemoveHandlerOnInvalidTarget(Event: TInvalidTargetEvent); *) -procedure _LapeTarget_RemoveHandlerOnInvalidTarget(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +procedure _LapeTarget_RemoveOnInvalidTargetEvent(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaTarget(Params^[0])^.RemoveHandlerOnInvalidTarget(TSimbaTarget.PInvalidTargetEvent(Params^[1])^); + PSimbaTarget(Params^[0])^.RemoveOnInvalidTargetEvent(TSimbaTarget.TInvalidTargetEvent(Params^[1]^)); end; procedure _LapeTarget_ToString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -293,21 +293,25 @@ procedure ImportTarget(Compiler: TSimbaScript_Compiler); addGlobalType([ 'packed record', ' {%CODETOOLS OFF}', - ' InternalData: array[0..' + IntToStr(SizeOf(TSimbaTarget) - 1) + '] of Byte;', + ' InternalData: array[1..' + IntToStr(SizeOf(TSimbaTarget) - LapeTypeSize[ltDynArray]) + '] of Byte;', ' {%CODETOOLS ON}', + ' InvalidTargetEvents: array of TMethod;', 'end;'], 'TTarget' ); - if (getGlobalType('TTarget').Size <> SizeOf(TSimbaTarget)) then - raise Exception.Create('SizeOf(TTarget) is wrong!'); with addGlobalVar('TTarget', '[]', 'Target') do + begin Used := duTrue; + if (Size <> SizeOf(TSimbaTarget)) then + SimbaException('SizeOf(TTarget) is wrong!'); + end; + addGlobalType('procedure(var Target: TTarget) of object', 'TInvalidTargetEvent', FFI_DEFAULT_ABI); - addGlobalFunc('function TTarget.AddHandlerOnInvalidTarget(Event: TInvalidTargetEvent): TInvalidTargetEvent', @_LapeTarget_AddHandlerOnInvalidTarget); - addGlobalFunc('procedure TTarget.RemoveHandlerOnInvalidTarget(Event: TInvalidTargetEvent)', @_LapeTarget_RemoveHandlerOnInvalidTarget); + addGlobalFunc('function TTarget.AddOnInvalidTargetEvent(Event: TInvalidTargetEvent): TInvalidTargetEvent', @_LapeTarget_AddOnInvalidTargetEvent); + addGlobalFunc('procedure TTarget.RemoveOnInvalidTargetEvent(Event: TInvalidTargetEvent)', @_LapeTarget_RemoveOnInvalidTargetEvent); addGlobalFunc('function TTarget.GetAutoFocus: Boolean', @_LapeTarget_GetAutoFocus); addGlobalFunc('procedure TTarget.SetAutoFocus(Value: Boolean)', @_LapeTarget_SetAutoFocus); diff --git a/Source/simba.target.pas b/Source/simba.target.pas index 9a001832e..ed127113e 100644 --- a/Source/simba.target.pas +++ b/Source/simba.target.pas @@ -50,7 +50,6 @@ TTargetMethods = record TSimbaTarget = packed record public type - PInvalidTargetEvent = ^TInvalidTargetEvent; TInvalidTargetEvent = procedure(var Target: TSimbaTarget) of object; private FTargetType: ETargetType; @@ -61,10 +60,11 @@ TTargetMethods = record FMethods: TTargetMethods; // Targets need to provide these. They are filled in SetWindow,SetEIOS etc. FCustomClientArea: TBox; FAutoSetFocus: Boolean; - FInvalidTargetHandlers: array[0..9] of TInvalidTargetEvent; + FInvalidTargetEvents: array of TInvalidTargetEvent; procedure ChangeTarget(TargetType: ETargetType); function HasMethod(Method: Pointer; Name: String): Boolean; + function CallInvalidTargetHandler: Boolean; procedure CheckInvalidTarget; procedure CheckAutoFocus; @@ -111,8 +111,8 @@ TTargetMethods = record function GetImageData(var Bounds: TBox; var Data: PColorBGRA; var DataWidth: Integer): Boolean; procedure FreeImageData(var Data: PColorBGRA); - function AddHandlerOnInvalidTarget(Event: TInvalidTargetEvent): TInvalidTargetEvent; - procedure RemoveHandlerOnInvalidTarget(Event: TInvalidTargetEvent); + function AddOnInvalidTargetEvent(Event: TInvalidTargetEvent): TInvalidTargetEvent; + procedure RemoveOnInvalidTargetEvent(Event: TInvalidTargetEvent); procedure ClearCustomClientArea; @@ -148,41 +148,32 @@ function TSimbaTarget.HasMethod(Method: Pointer; Name: String): Boolean; Result := True; end; -procedure TSimbaTarget.CheckInvalidTarget; - - function HasInvalidTargetHandler: Boolean; - var - I: Integer; +function TSimbaTarget.CallInvalidTargetHandler: Boolean; +var + I: Integer; +begin + for I := 0 to High(FInvalidTargetEvents) do begin - Result := False; + FInvalidTargetEvents[I](Self); - for I := 0 to High(FInvalidTargetHandlers) do - if Assigned(FInvalidTargetHandlers[I]) then - Exit(True); + if IsValid() then + begin + Result := True; + Exit; + end; end; - function CallInvalidTargetHandler: Boolean; - var - I: Integer; - begin - Result := False; - - for I := 0 to High(FInvalidTargetHandlers) do - if Assigned(FInvalidTargetHandlers[I]) then - begin - FInvalidTargetHandlers[I](Self); - if IsValid() then - Exit(True); - end; - end; + Result := False; +end; +procedure TSimbaTarget.CheckInvalidTarget; var Attempt: Integer; begin if IsValid() then Exit; - if HasInvalidTargetHandler() then + if (Length(FInvalidTargetEvents) > 0) then begin for Attempt := 1 to 5 do begin @@ -493,30 +484,20 @@ procedure TSimbaTarget.FreeImageData(var Data: PColorBGRA); FreeMem(Data); end; -function TSimbaTarget.AddHandlerOnInvalidTarget(Event: TInvalidTargetEvent): TInvalidTargetEvent; -var - I: Integer; +function TSimbaTarget.AddOnInvalidTargetEvent(Event: TInvalidTargetEvent): TInvalidTargetEvent; begin Result := Event; - for I := 0 to High(FInvalidTargetHandlers) do - if (FInvalidTargetHandlers[I] = Event) then - Exit; - for I := 0 to High(FInvalidTargetHandlers) do - if (FInvalidTargetHandlers[I] = nil) then - begin - FInvalidTargetHandlers[I] := Event; - Exit; - end; + FInvalidTargetEvents += [Event]; end; -procedure TSimbaTarget.RemoveHandlerOnInvalidTarget(Event: TInvalidTargetEvent); +procedure TSimbaTarget.RemoveOnInvalidTargetEvent(Event: TInvalidTargetEvent); var I: Integer; begin - for I := 0 to High(FInvalidTargetHandlers) do - if (FInvalidTargetHandlers[I] = Event) then - FInvalidTargetHandlers[I] := nil; + for I := High(FInvalidTargetEvents) downto 0 do + if (Event = FInvalidTargetEvents[I]) then + Delete(FInvalidTargetEvents, I, 1); end; procedure TSimbaTarget.ClearCustomClientArea;