diff --git a/Source/Simba.lpr b/Source/Simba.lpr index ec29ec8d5..9ba590d55 100644 --- a/Source/Simba.lpr +++ b/Source/Simba.lpr @@ -16,8 +16,8 @@ simba.form_functionlist, simba.form_output, simba.form_colorpickhistory, simba.form_filebrowser, simba.form_notes, simba.form_settings, simba.form_openexample, simba.form_shapebox, simba.form_backups, simba.form_findinfiles, simba.form_downloadsimba, simba.form_package, - simba.compiler_dump, simba.plugin_dump, simba.script_runner, - simba.ide_initialization, simba.ide_analytics; + simba.plugin_dump, simba.script_runner, + simba.ide_initialization, simba.ide_analytics, simba.script; begin {$IF DECLARED(SetHeapTraceOutput)} @@ -53,7 +53,12 @@ if Application.HasOption('dumpcompiler') then begin - DumpCompiler(Application.Params[Application.ParamCount]); + with TSimbaScript.Create() do + try + Dump(Application.Params[Application.ParamCount]); + finally + Free(); + end; Halt(); end; diff --git a/Source/script/imports/lcl/simba.import_lcl_comctrls.pas b/Source/script/imports/lcl/simba.import_lcl_comctrls.pas index 1ecc03c92..fc865d3b3 100644 --- a/Source/script/imports/lcl/simba.import_lcl_comctrls.pas +++ b/Source/script/imports/lcl/simba.import_lcl_comctrls.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportLCLComCtrls(Compiler: TSimbaScript_Compiler); +procedure ImportLCLComCtrls(Script: TSimbaScript); implementation @@ -633,9 +633,9 @@ procedure _LapeStatusBar_Create(const Params: PParamArray; const Result: Pointer PStatusBar(Result)^ := TStatusBar.Create(PComponent(Params^[0])^); end; -procedure ImportLCLComCtrls(Compiler: TSimbaScript_Compiler); +procedure ImportLCLComCtrls(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addGlobalType('enum(BottomRight, TopLeft, Both)', 'ELazTickMark'); addGlobalType('enum(None, Auto, Manual)', 'ELazStickStyle'); diff --git a/Source/script/imports/lcl/simba.import_lcl_controls.pas b/Source/script/imports/lcl/simba.import_lcl_controls.pas index 261c0a92a..3f0eeeace 100644 --- a/Source/script/imports/lcl/simba.import_lcl_controls.pas +++ b/Source/script/imports/lcl/simba.import_lcl_controls.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportLCLControls(Compiler: TSimbaScript_Compiler); +procedure ImportLCLControls(Script: TSimbaScript); implementation @@ -788,9 +788,9 @@ procedure _LapeGraphicControl_Update(const Params: PParamArray); LAPE_WRAPPER_CA PGraphicControl(Params^[0])^.Update(); end; -procedure ImportLCLControls(Compiler: TSimbaScript_Compiler); +procedure ImportLCLControls(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addGlobalType('set of enum(Shift, Alt, Ctrl, Left, Right, Middle, Double, Meta, Super, Hyper, AltGr, Caps, Num, Scroll, Triple, Quad, Extra1, Extra2)', 'ELazShiftStates'); addGlobalType('enum(Left, Right, Middle, Extra1, Extra2)', 'ELazMouseButton'); diff --git a/Source/script/imports/lcl/simba.import_lcl_extctrls.pas b/Source/script/imports/lcl/simba.import_lcl_extctrls.pas index 2106eef98..bcd7f11c5 100644 --- a/Source/script/imports/lcl/simba.import_lcl_extctrls.pas +++ b/Source/script/imports/lcl/simba.import_lcl_extctrls.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportLCLExtCtrls(Compiler: TSimbaScript_Compiler); +procedure ImportLCLExtCtrls(Script: TSimbaScript); implementation @@ -245,9 +245,9 @@ procedure _LapePanel_Create(const Params: PParamArray; const Result: Pointer); L PPanel(Result)^ := TPanel.Create(PComponent(Params^[0])^); end; -procedure ImportLCLExtCtrls(Compiler: TSimbaScript_Compiler); +procedure ImportLCLExtCtrls(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addGlobalType('enum(None, Lowered, Raised, Space)', 'ELazPanelBevel'); diff --git a/Source/script/imports/lcl/simba.import_lcl_form.pas b/Source/script/imports/lcl/simba.import_lcl_form.pas index ccbf1d19b..a81dcd314 100644 --- a/Source/script/imports/lcl/simba.import_lcl_form.pas +++ b/Source/script/imports/lcl/simba.import_lcl_form.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.threading, simba.script_compiler; + simba.base, simba.threading, simba.script; -procedure ImportLCLForm(Compiler: TSimbaScript_Compiler); +procedure ImportLCLForm(Script: TSimbaScript); implementation @@ -955,9 +955,9 @@ procedure _LapeColorDialog_Create(const Params: PParamArray; const Result: Point PColorDialog(Result)^ := TColorDialog.Create(PComponent(Params^[0])^); end; -procedure ImportLCLForm(Compiler: TSimbaScript_Compiler); +procedure ImportLCLForm(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addGlobalType('enum(Default, Always, Never)', 'ELazFormShowInTaskbar'); addGlobalType('enum(None, Single, Sizeable, Dialog, ToolWindow, SizeToolWin)', 'ELazFormBorderStyle'); diff --git a/Source/script/imports/lcl/simba.import_lcl_graphics.pas b/Source/script/imports/lcl/simba.import_lcl_graphics.pas index 9d391660f..f3dedc8a6 100644 --- a/Source/script/imports/lcl/simba.import_lcl_graphics.pas +++ b/Source/script/imports/lcl/simba.import_lcl_graphics.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportLCLGraphics(Compiler: TSimbaScript_Compiler); +procedure ImportLCLGraphics(Script: TSimbaScript); implementation @@ -758,9 +758,9 @@ procedure _LapePicture_OnChange_Write(const Params: PParamArray); LAPE_WRAPPER_C PPicture(Params^[0])^.OnChange := PNotifyEvent(Params^[1])^; end; -procedure ImportLCLGraphics(Compiler: TSimbaScript_Compiler); +procedure ImportLCLGraphics(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addGlobalType('record Left, Top ,Right, Bottom: Integer; end', 'TLazRect'); addGlobalType('enum(fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased, fqCleartype, fqCleartypeNatural)', 'ELazFontQuality'); diff --git a/Source/script/imports/lcl/simba.import_lcl_misc.pas b/Source/script/imports/lcl/simba.import_lcl_misc.pas index a9373fe8d..e3d2ced58 100644 --- a/Source/script/imports/lcl/simba.import_lcl_misc.pas +++ b/Source/script/imports/lcl/simba.import_lcl_misc.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportLCLMisc(Compiler: TSimbaScript_Compiler); +procedure ImportLCLMisc(Script: TSimbaScript); implementation @@ -541,9 +541,9 @@ procedure _LapeButtonPanel_ShowGlyphs_Write(const Params: PParamArray); LAPE_WRA PButtonPanel(Params^[0])^.ShowGlyphs := PPanelButtons(Params^[1])^; end; -procedure ImportLCLMisc(Compiler: TSimbaScript_Compiler); +procedure ImportLCLMisc(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addClass('TLazCustomFloatSpinEdit', 'TLazCustomEdit'); addProperty('TLazCustomFloatSpinEdit', 'DecimalPlaces', 'Integer', @_LapeCustomFloatSpinEdit_DecimalPlaces_Read, @_LapeCustomFloatSpinEdit_DecimalPlaces_Write); diff --git a/Source/script/imports/lcl/simba.import_lcl_stdctrls.pas b/Source/script/imports/lcl/simba.import_lcl_stdctrls.pas index a44eb27ba..dcd648ebf 100644 --- a/Source/script/imports/lcl/simba.import_lcl_stdctrls.pas +++ b/Source/script/imports/lcl/simba.import_lcl_stdctrls.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportLCLStdCtrls(Compiler: TSimbaScript_Compiler); +procedure ImportLCLStdCtrls(Script: TSimbaScript); implementation @@ -1082,9 +1082,9 @@ procedure _LapeRadioButton_Create(const Params: PParamArray; const Result: Point PRadioButton(Result)^ := TRadioButton.Create(PComponent(Params^[0])^); end; -procedure ImportLCLStdCtrls(Compiler: TSimbaScript_Compiler); +procedure ImportLCLStdCtrls(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addGlobalType('enum(ssNone, ssHorizontal, ssVertical, ssBoth, ssAutoHorizontal, ssAutoVertical, ssAutoBoth)', 'ELazScrollStyle'); addGlobalType('set of enum(odSelected, odGrayed, odDisabled, odChecked, odFocused, odDefault, odHotLight, odInactive, odNoAccel, odNoFocusRect, odReserved1, odReserved2, odComboBoxEdit, odBackgroundPainted)', 'ELazOwnerDrawStates'); diff --git a/Source/script/imports/lcl/simba.import_lcl_system.pas b/Source/script/imports/lcl/simba.import_lcl_system.pas index cca3a2116..d96a12e03 100644 --- a/Source/script/imports/lcl/simba.import_lcl_system.pas +++ b/Source/script/imports/lcl/simba.import_lcl_system.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportLCLSystem(Compiler: TSimbaScript_Compiler); +procedure ImportLCLSystem(Script: TSimbaScript); implementation @@ -593,9 +593,9 @@ procedure _LapeComponent_Tag_Write(const Params: PParamArray); LAPE_WRAPPER_CALL PComponent(Params^[0])^.Tag := PPtrInt(Params^[1])^; end; -procedure ImportLCLSystem(Compiler: TSimbaScript_Compiler); +procedure ImportLCLSystem(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addClass('TObject', 'Pointer'); diff --git a/Source/script/imports/simba.import_async.pas b/Source/script/imports/simba.import_async.pas index a498ab9ed..97580887e 100644 --- a/Source/script/imports/simba.import_async.pas +++ b/Source/script/imports/simba.import_async.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportASync(Compiler: TSimbaScript_Compiler); +procedure ImportASync(Script: TSimbaScript); implementation @@ -202,11 +202,11 @@ procedure ASync.ScheduleStop(Name: String); static; Stop a scheduled method. *) -procedure ImportASync(Compiler: TSimbaScript_Compiler); +procedure ImportASync(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'ASync'; + DumpSection := 'ASync'; // namespace addGlobalType('record end;', 'ASync'); @@ -283,7 +283,7 @@ procedure ImportASync(Compiler: TSimbaScript_Compiler); 'end;' ]); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_atpa.pas b/Source/script/imports/simba.import_atpa.pas index 398769d10..bb0683800 100644 --- a/Source/script/imports/simba.import_atpa.pas +++ b/Source/script/imports/simba.import_atpa.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportATPA(Compiler: TSimbaScript_Compiler); +procedure ImportATPA(Script: TSimbaScript); implementation @@ -396,11 +396,11 @@ procedure _LapeATPA_Intersection(const Params: PParamArray; const Result: Pointe PPointArray(Result)^ := P2DPointArray(Params^[0])^.Intersection(); end; -procedure ImportATPA(Compiler: TSimbaScript_Compiler); +procedure ImportATPA(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'T2DPointArray'; + DumpSection := 'T2DPointArray'; addGlobalFunc('function T2DPointArray.Offset(P: TPoint): T2DPointArray', @_LapeATPA_Offset1); @@ -444,7 +444,7 @@ procedure ImportATPA(Compiler: TSimbaScript_Compiler); addGlobalFunc('function T2DPointArray.Merge: TPointArray;', @_LapeATPA_Merge); addGlobalFunc('function T2DPointArray.Intersection: TPointArray; overload;', @_LapeATPA_Intersection); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_base.pas b/Source/script/imports/simba.import_base.pas index e73800b35..961c603c6 100644 --- a/Source/script/imports/simba.import_base.pas +++ b/Source/script/imports/simba.import_base.pas @@ -7,9 +7,9 @@ interface uses Classes, SysUtils, lptypes, lpvartypes, lpparser, ffi, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportBase(Compiler: TSimbaScript_Compiler); +procedure ImportBase(Script: TSimbaScript); implementation @@ -729,11 +729,11 @@ procedure _LapeArraySymDifference_PointArray(const Params: PParamArray; const Re PPointArray(Result)^ := PPointArray(Params^[0])^.SymmetricDifference(PPointArray(Params^[1])^); end; -procedure ImportBase(Compiler: TSimbaScript_Compiler); +procedure ImportBase(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Base'; + DumpSection := 'Base'; addBaseDefine('SIMBA' + Format('%d', [SIMBA_VERSION])); addBaseDefine('SIMBAMAJOR' + Format('%d', [SIMBA_MAJOR])); @@ -795,7 +795,7 @@ procedure ImportBase(Compiler: TSimbaScript_Compiler); addGlobalFunc('function TByteArray.ToString: String;', @_LapeByteArray_ToString); addGlobalFunc('procedure TByteArray.FromString(Str: String);', @_LapeByteArray_FromString); - ImportingSection := ''; + DumpSection := ''; addClass('TBaseClass', 'Pointer'); addProperty('TBaseClass', 'Name', 'String', @_LapeBaseClass_Name_Read, @_LapeBaseClass_Name_Write); diff --git a/Source/script/imports/simba.import_box.pas b/Source/script/imports/simba.import_box.pas index 38eae5355..9be153cf9 100644 --- a/Source/script/imports/simba.import_box.pas +++ b/Source/script/imports/simba.import_box.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportBox(Compiler: TSimbaScript_Compiler); +procedure ImportBox(Script: TSimbaScript); implementation @@ -445,11 +445,11 @@ procedure _LapeBox_BottomRight(const Params: PParamArray; const Result: Pointer) PPoint(Result)^ := PBox(Params^[0])^.BottomRight; end; -procedure ImportBox(Compiler: TSimbaScript_Compiler); +procedure ImportBox(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'TBox'; + DumpSection := 'TBox'; addGlobalFunc('function Box(X1, Y1, X2, Y2: Integer): TBox; overload', @_LapeBox1); addGlobalFunc('function Box(Mid: TPoint; XRad, YRad: Integer): TBox; overload', @_LapeBox2); @@ -493,7 +493,7 @@ procedure ImportBox(Compiler: TSimbaScript_Compiler); addGlobalFunc('property TBox.BottomLeft: TPoint;', @_LapeBox_BottomLeft); addGlobalFunc('property TBox.BottomRight: TPoint;', @_LapeBox_BottomRight); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_boxarray.pas b/Source/script/imports/simba.import_boxarray.pas index 7c9c60cc6..20ac19810 100644 --- a/Source/script/imports/simba.import_boxarray.pas +++ b/Source/script/imports/simba.import_boxarray.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportBoxArray(Compiler: TSimbaScript_Compiler); +procedure ImportBoxArray(Script: TSimbaScript); implementation @@ -226,11 +226,11 @@ procedure _LapeBoxArray_Sort2(const Params: PParamArray; const Result: Pointer); PBoxArray(Result)^ := PBoxArray(Params^[0])^.Sort(PDoubleArray(Params^[1])^, PBoolean(Params^[2])^); end; -procedure ImportBoxArray(Compiler: TSimbaScript_Compiler); +procedure ImportBoxArray(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'TBoxArray'; + DumpSection := 'TBoxArray'; addGlobalFunc('function TBoxArray.Create(Start: TPoint; Columns, Rows, Width, Height: Integer; Spacing: TPoint): TBoxArray; static;', @_LapeBoxArray_Create); addGlobalFunc('function TBoxArray.Pack: TBoxArray;', @_LapeBoxArray_Pack); @@ -255,7 +255,7 @@ procedure ImportBoxArray(Compiler: TSimbaScript_Compiler); addGlobalFunc('function TBoxArray.ContainsPoint(P: TPoint; out Index: Integer): Boolean; overload;', @_LapeBoxArray_ContainsPoint1); addGlobalFunc('function TBoxArray.ContainsPoint(P: TPoint): Boolean; overload;', @_LapeBoxArray_ContainsPoint2); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_circle.pas b/Source/script/imports/simba.import_circle.pas index 834670fea..14a8d89a4 100644 --- a/Source/script/imports/simba.import_circle.pas +++ b/Source/script/imports/simba.import_circle.pas @@ -11,9 +11,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportCircle(Compiler: TSimbaScript_Compiler); +procedure ImportCircle(Script: TSimbaScript); implementation @@ -262,11 +262,11 @@ procedure _LapePoint_IN_Cicle(const Params: PParamArray; const Result: Pointer); PBoolean(Result)^ := PPoint(Params^[0])^ in PCircle(Params^[1])^; end; -procedure ImportCircle(Compiler: TSimbaScript_Compiler); +procedure ImportCircle(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'TCircle'; + DumpSection := 'TCircle'; addGlobalType('record X, Y, Radius: Integer; end;', 'TCircle'); addGlobalType('array of TCircle;', 'TCircleArray'); @@ -293,8 +293,8 @@ procedure ImportCircle(Compiler: TSimbaScript_Compiler); addGlobalFunc('operator in(Left: TPoint; Right: TCircle): Boolean;', @_LapePoint_IN_Cicle); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_colormath.pas b/Source/script/imports/simba.import_colormath.pas index e92555bf2..ea87656d4 100644 --- a/Source/script/imports/simba.import_colormath.pas +++ b/Source/script/imports/simba.import_colormath.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportColorMath(Compiler: TSimbaScript_Compiler); +procedure ImportColorMath(Script: TSimbaScript); implementation @@ -667,11 +667,11 @@ function TColor.B: Byte; ``` *) -procedure ImportColorMath(Compiler: TSimbaScript_Compiler); +procedure ImportColorMath(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Color Math'; + DumpSection := 'Color Math'; addGlobalType('enum(RGB, HSV, HSL, XYZ, LAB, LCH, DELTAE)', 'EColorSpace'); addGlobalType('array [0..2] of Single', 'TChannelMultipliers'); @@ -972,7 +972,7 @@ procedure ImportColorMath(Compiler: TSimbaScript_Compiler); 'end;' ], 'Colors'); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_datetime.pas b/Source/script/imports/simba.import_datetime.pas index 07aa5eb26..d6f8155d8 100644 --- a/Source/script/imports/simba.import_datetime.pas +++ b/Source/script/imports/simba.import_datetime.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportDateTime(Compiler: TSimbaScript_Compiler); +procedure ImportDateTime(Script: TSimbaScript); implementation @@ -619,11 +619,11 @@ procedure _LapeFormatMilliseconds2(const Params: PParamArray; const Result: Poin PString(Result)^ := FormatMilliseconds(PDouble(Params^[0])^, PBoolean(Params^[1])^); end; -procedure ImportDateTime(Compiler: TSimbaScript_Compiler); +procedure ImportDateTime(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Date & Time'; + DumpSection := 'Date & Time'; addGlobalFunc('function TDateTime.Create(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMillisecond: Integer): TDateTime; static; overload', @_LapeDateTime_Create1); addGlobalFunc('function TDateTime.Create(AYear, AMonth, ADay: Integer): TDateTime; static; overload', @_LapeDateTime_Create2); @@ -714,7 +714,7 @@ ' TStopwatch = record', 'end;' ]); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_debugimage.pas b/Source/script/imports/simba.import_debugimage.pas index 64ba441c9..3896e5c62 100644 --- a/Source/script/imports/simba.import_debugimage.pas +++ b/Source/script/imports/simba.import_debugimage.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script, simba.image; -procedure ImportDebugImage(Compiler: TSimbaScript_Compiler); +procedure ImportDebugImage(Script: TSimbaScript); implementation @@ -134,29 +134,57 @@ procedure ShowOnClient(ATPA: T2DPointArray); ``` *) + (* -DebugImageUpdate ----------------- +DebugImageMaxSize +----------------- ``` -procedure DebugImageUpdate(Bitmap: TSimbaImage); +procedure DebugImageMaxSize(MaxWidth, MaxHeight: Integer); ``` *) +procedure _LapeDebugImage_MaxSize(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('DebugImage requires Simba communication'); + SimbaCommunication.DebugImage_SetMaxSize(PInteger(Params^[1])^, PInteger(Params^[2])^); + end; +end; (* -DebugImageDisplay ------------------ +DebugImageShow +-------------- ``` -procedure DebugImageDisplay(Width, Height: Integer); +procedure DebugImageShow(Image: TImage; EnsureVisible: Boolean = True); ``` *) +procedure _LapeDebugImage_Show(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('DebugImage requires Simba communication'); + SimbaCommunication.DebugImage_Show(PSimbaImage(Params^[1])^, PBoolean(Params^[2])^); + end; +end; (* -DebugImageDisplay ------------------ +DebugImageUpdate +---------------- ``` -procedure DebugImageDisplay(X, Y,Width, Height: Integer); +procedure DebugImageUpdate(Bitmap: TSimbaImage); ``` *) +procedure _LapeDebugImage_Update(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('DebugImage requires Simba communication'); + SimbaCommunication.DebugImage_Update(PSimbaImage(Params^[1])^); + end; +end; (* DebugImageClose @@ -165,81 +193,73 @@ procedure DebugImageDisplay(X, Y,Width, Height: Integer); procedure DebugImageClose; ``` *) +procedure _LapeDebugImage_Close(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('DebugImage requires Simba communication'); + SimbaCommunication.DebugImage_Hide(); + end; +end; (* -DebugImageSetMaxSize --------------------- +DebugImageDisplay +----------------- ``` -procedure DebugImageSetMaxSize(MaxWidth, MaxHeight: Integer); +procedure DebugImageDisplay(Width, Height: Integer); ``` *) +procedure _LapeDebugImage_Display1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('DebugImage requires Simba communication'); + SimbaCommunication.DebugImage_Display(PInteger(Params^[1])^, PInteger(Params^[2])^); + end; +end; (* -DebugImageShow --------------- +DebugImageDisplay +----------------- ``` -procedure DebugImageShow(Image: TImage; EnsureVisible: Boolean = True); +procedure DebugImageDisplay(X, Y,Width, Height: Integer); ``` *) - -procedure ImportDebugImage(Compiler: TSimbaScript_Compiler); +procedure _LapeDebugImage_Display2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - with Compiler do + with TSimbaScript(Params^[0]) do begin - ImportingSection := 'Debug Image'; - - addGlobalFunc( - 'procedure DebugImageSetMaxSize(MaxWidth, MaxHeight: Integer);', [ - 'begin', - ' _SimbaScript.DebugImage_SetMaxSize(MaxWidth, MaxHeight);', - 'end;' - ]); - - addGlobalFunc( - 'procedure DebugImageDisplay(Width, Height: Integer); overload;', [ - 'begin', - ' _SimbaScript.DebugImage_Display(Width, Height);', - 'end;' - ]); - - addGlobalFunc( - 'procedure DebugImageDisplay(X, Y, Width, Height: Integer); overload;', [ - 'begin', - ' _SimbaScript.DebugImage_Display(X, Y, Width, Height);', - 'end;' - ]); - - addGlobalFunc( - 'procedure DebugImageClose;', [ - 'begin', - ' _SimbaScript.DebugImage_Hide();', - 'end;' - ]); + if (SimbaCommunication = nil) then + SimbaException('DebugImage requires Simba communication'); + SimbaCommunication.DebugImage_Display(PInteger(Params^[1])^, PInteger(Params^[2])^, PInteger(Params^[3])^, PInteger(Params^[4])^); + end; +end; - addGlobalFunc( - 'procedure DebugImageUpdate(Image: TImage);', [ - 'begin', - ' _SimbaScript.DebugImage_Update(Image);', - 'end;' - ]); +procedure ImportDebugImage(Script: TSimbaScript); +begin + with Script.Compiler do + begin + DumpSection := 'Debug Image'; - addGlobalFunc( - 'procedure DebugImageShow(Image: TImage; EnsureVisible: Boolean = True);', [ - 'begin', - ' _SimbaScript.DebugImage_Show(Image, EnsureVisible);', - 'end;' - ]); + addGlobalMethod('procedure DebugImageSetMaxSize(MaxWidth, MaxHeight: Integer);', @_LapeDebugImage_MaxSize, Script); + addGlobalMethod('procedure DebugImageDisplay(Width, Height: Integer); overload', @_LapeDebugImage_Display1, Script); + addGlobalMethod('procedure DebugImageDisplay(X, Y, Width, Height: Integer); overload', @_LapeDebugImage_Display2, Script); + addGlobalMethod('procedure DebugImageClose', @_LapeDebugImage_Close, Script); + addGlobalMethod('procedure DebugImageUpdate(Image: TImage)', @_LapeDebugImage_Update, Script); + addGlobalMethod('procedure DebugImageShow(Image: TImage; EnsureVisible: Boolean = True)', @_LapeDebugImage_Show, Script); - ImportingSection := 'Image'; + DumpSection := 'Image'; addGlobalFunc( 'procedure TImage.Show(EnsureVisible: Boolean = True);', [ 'begin', - ' _SimbaScript.DebugImage_Show(Self, EnsureVisible);', + ' DebugImageShow(Self, EnsureVisible);', 'end;' ]); - ImportingSection := 'Debug Image'; + DumpSection := 'Debug Image'; addGlobalFunc( 'procedure Show(Matrix: TIntegerMatrix); overload;', [ @@ -407,8 +427,8 @@ procedure ImportDebugImage(Compiler: TSimbaScript_Compiler); 'end;' ]); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_dtm.pas b/Source/script/imports/simba.import_dtm.pas index fc6a60064..51ced5c86 100644 --- a/Source/script/imports/simba.import_dtm.pas +++ b/Source/script/imports/simba.import_dtm.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportDTM(Compiler: TSimbaScript_Compiler); +procedure ImportDTM(Script: TSimbaScript); implementation @@ -132,11 +132,11 @@ procedure _LapeDTM_Normalize(const Params: PParamArray); LAPE_WRAPPER_CALLING_CO PDTM(Params^[0])^.Normalize(); end; -procedure ImportDTM(Compiler: TSimbaScript_Compiler); +procedure ImportDTM(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'DTM'; + DumpSection := 'DTM'; addGlobalType([ 'record', @@ -162,8 +162,8 @@ procedure ImportDTM(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TDTM.Normalize;', @_LapeDTM_Normalize); addGlobalFunc('function TDTM.Valid: Boolean;', @_LapeDTM_Normalize); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_encoding.pas b/Source/script/imports/simba.import_encoding.pas index 407f438a9..f55e5a49d 100644 --- a/Source/script/imports/simba.import_encoding.pas +++ b/Source/script/imports/simba.import_encoding.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, SynLZ, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportEncoding(Compiler: TSimbaScript_Compiler); +procedure ImportEncoding(Script: TSimbaScript); implementation @@ -314,11 +314,11 @@ procedure _LapeFastDecompressImages(const Params: PParamArray; const Result: Poi TSimbaImageArray(Result^) := SimbaImage_FastDecompress(PPointer(Params^[0])^, PSizeUInt(Params^[1])^); end; -procedure ImportEncoding(Compiler: TSimbaScript_Compiler); +procedure ImportEncoding(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Encoding'; + DumpSection := 'Encoding'; addGlobalType('enum(SHA1, SHA256, SHA384, SHA512, MD5)', 'EHashAlgo'); addGlobalType('enum(b64URL, b64, b32, b32Hex, b16)', 'EBaseEncoding'); @@ -352,7 +352,7 @@ procedure ImportEncoding(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure FastCompressImages(Images: TImageArray; var Data: Pointer; out DataSize: SizeUInt);', @_LapeFastCompressImages); addGlobalFunc('function FastDecompressImages(Data: Pointer; out DataLen: SizeUInt): TImageArray', @_LapeFastDecompressImages); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_externalcanvas.pas b/Source/script/imports/simba.import_externalcanvas.pas index 3a347cd36..fd5b60ca5 100644 --- a/Source/script/imports/simba.import_externalcanvas.pas +++ b/Source/script/imports/simba.import_externalcanvas.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, Graphics, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportExternalCanvas(Compiler: TSimbaScript_Compiler); +procedure ImportExternalCanvas(Script: TSimbaScript); implementation @@ -549,9 +549,9 @@ procedure _LapeExternalCanvas_EndUpdate(const Params: PParamArray); LAPE_WRAPPER PSimbaExternalCanvas(Params^[0])^.EndUpdate(); end; -procedure ImportExternalCanvas(Compiler: TSimbaScript_Compiler); +procedure ImportExternalCanvas(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addClass('TExternalCanvas', 'TBaseClass'); diff --git a/Source/script/imports/simba.import_file.pas b/Source/script/imports/simba.import_file.pas index 054b5fa63..3e7b9a1a3 100644 --- a/Source/script/imports/simba.import_file.pas +++ b/Source/script/imports/simba.import_file.pas @@ -11,9 +11,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportFile(Compiler: TSimbaScript_Compiler); +procedure ImportFile(Script: TSimbaScript); implementation @@ -711,11 +711,11 @@ procedure _LapeGetTempFileName(const Params: PParamArray; const Result: Pointer) PString(Result)^ := GetTempFileName(); end; -procedure ImportFile(Compiler: TSimbaScript_Compiler); +procedure ImportFile(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'File'; + DumpSection := 'File'; addGlobalVar(PATH_SEP, 'PATH_SEP').isConstant := True; addGlobalVar(LINE_SEP, 'LINE_SEP').isConstant := True; @@ -785,8 +785,8 @@ procedure ImportFile(Compiler: TSimbaScript_Compiler); addGlobalFunc('function DirSize(Path: String): Int64', @_LapeDirSize); addGlobalFunc('function DirSizeInMegaBytes(Path: String): Single', @_LapeDirSizeInMegaBytes); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_image.pas b/Source/script/imports/simba.import_image.pas index 5fd3d99cd..c795c81bb 100644 --- a/Source/script/imports/simba.import_image.pas +++ b/Source/script/imports/simba.import_image.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); +procedure ImportSimbaImage(Script: TSimbaScript); implementation @@ -1826,17 +1826,17 @@ procedure TImage.DrawTarget(P: TPoint; Bounds: TBox = [-1,-1,-1,-1]); overload; TImage.Show ----------- ``` -procedure TImage.Show; +procedure TImage.Show(EnsureVisible: Boolean = True); ``` Show a image on the debug image. *) -procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); +procedure ImportSimbaImage(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Image'; + DumpSection := 'Image'; addClass('TImage', 'TBaseClass'); @@ -2018,7 +2018,7 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('function TImage.FindEdges(MinDiff: Single; ColorSpace: EColorSpace; Multipliers: TChannelMultipliers): TPointArray; overload;', @_LapeImage_FindEdges1); addGlobalFunc('function TImage.FindEdges(MinDiff: Single): TPointArray; overload;', @_LapeImage_FindEdges2); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_imagebox.pas b/Source/script/imports/simba.import_imagebox.pas index c18b05f7d..7f7320275 100644 --- a/Source/script/imports/simba.import_imagebox.pas +++ b/Source/script/imports/simba.import_imagebox.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, Controls, Graphics, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportSimbaImageBox(Compiler: TSimbaScript_Compiler); +procedure ImportSimbaImageBox(Script: TSimbaScript); implementation @@ -383,9 +383,9 @@ procedure _LapeSimbaImageBoxCanvas_DrawHeatmap(const Params: PParamArray); LAPE_ PSimbaImageBoxCanvas(Params^[0])^.DrawHeatmap(PSingleMatrix(Params^[1])^); end; -procedure ImportSimbaImageBox(Compiler: TSimbaScript_Compiler); +procedure ImportSimbaImageBox(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addClass('TImageBoxCanvas'); diff --git a/Source/script/imports/simba.import_internal.pas b/Source/script/imports/simba.import_internal.pas deleted file mode 100644 index 02ff9e9e7..000000000 --- a/Source/script/imports/simba.import_internal.pas +++ /dev/null @@ -1,168 +0,0 @@ -unit simba.import_internal; - -{$i simba.inc} - -interface - -uses - Classes, SysUtils, lptypes, - simba.base, simba.script_compiler; - -procedure ImportInternal(Compiler: TSimbaScript_Compiler); - -implementation - -uses - lpvartypes, - simba.script, simba.image, simba.process, - simba.vartype_pointarray, simba.vartype_ordarray, simba.vartype_stringarray, - simba.vartype_floatmatrix; - -type - PSimbaScript = ^TSimbaScript; - -procedure _LapeSetSimbaTitle(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('SetSimbaTitle requires Simba communication'); - SimbaCommunication.SetSimbaTitle(PString(Params^[1])^); - end; -end; - -procedure _LapeDebugImage_SetMaxSize(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('DebugImage requires Simba communication'); - SimbaCommunication.DebugImage_SetMaxSize(PInteger(Params^[1])^, PInteger(Params^[2])^); - end; -end; - -procedure _LapeDebugImage_Show(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('DebugImage requires Simba communication'); - SimbaCommunication.DebugImage_Show(PSimbaImage(Params^[1])^, PBoolean(Params^[2])^); - end; -end; - -procedure _LapeDebugImage_Update(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('DebugImage requires Simba communication'); - SimbaCommunication.DebugImage_Update(PSimbaImage(Params^[1])^); - end; -end; - -procedure _LapeDebugImage_Hide(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('DebugImage requires Simba communication'); - SimbaCommunication.DebugImage_Hide(); - end; -end; - -procedure _LapeDebugImage_Display1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('DebugImage requires Simba communication'); - SimbaCommunication.DebugImage_Display(PInteger(Params^[1])^, PInteger(Params^[2])^); - end; -end; - -procedure _LapeDebugImage_Display2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('DebugImage requires Simba communication'); - SimbaCommunication.DebugImage_Display(PInteger(Params^[1])^, PInteger(Params^[2])^, PInteger(Params^[3])^, PInteger(Params^[4])^); - end; -end; - -procedure _LapePause(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - State := ESimbaScriptState.STATE_PAUSED; -end; - -procedure _LapeShowTrayNotification(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('TrayNotification requires Simba communication'); - SimbaCommunication.ShowTrayNotification(PString(Params^[1])^, PString(Params^[2])^, PInteger(Params^[3])^); - end; -end; - -procedure _LapeGetSimbaPID(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('GetSimbaPID requires Simba communication'); - TProcessID(Result^) := SimbaCommunication.GetSimbaPID(); - end; -end; - -procedure _LapeGetSimbaTargetPID(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('GetSimbaTargetPID requires Simba communication'); - TProcessID(Result^) := SimbaCommunication.GetSimbaTargetPID(); - end; -end; - -procedure _LapeGetSimbaTargetWindow(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - with PSimbaScript(Params^[0])^ do - begin - if (SimbaCommunication = nil) then - SimbaException('GetSimbaTargetWindow requires Simba communication'); - PWindowHandle(Result)^ := SimbaCommunication.GetSimbaTargetWindow(); - end; -end; - -procedure ImportInternal(Compiler: TSimbaScript_Compiler); -begin - with Compiler do - begin - ImportingSection := '!Hidden'; - - addGlobalType('type Pointer', '_TSimbaScript'); - addGlobalVar('_TSimbaScript', nil, '_SimbaScript'); // Value added later - - addGlobalFunc('procedure _TSimbaScript.DebugImage_SetMaxSize(Width, Height: Integer)', @_LapeDebugImage_SetMaxSize); - addGlobalFunc('procedure _TSimbaScript.DebugImage_Show(Image: TImage; EnsureVisible: Boolean)', @_LapeDebugImage_Show); - addGlobalFunc('procedure _TSimbaScript.DebugImage_Update(Image: TImage)', @_LapeDebugImage_Update); - addGlobalFunc('procedure _TSimbaScript.DebugImage_Hide()', @_LapeDebugImage_Hide); - addGlobalFunc('procedure _TSimbaScript.DebugImage_Display(Width, Height: Integer); overload', @_LapeDebugImage_Display1); - addGlobalFunc('procedure _TSimbaScript.DebugImage_Display(X, Y, Width, Height: Integer); overload', @_LapeDebugImage_Display2); - addGlobalFunc('procedure _TSimbaScript.Pause()', @_LapePause); - addGlobalFunc('procedure _TSimbaScript.SetSimbaTitle(S: String)', @_LapeSetSimbaTitle); - addGlobalFunc('procedure _TSimbaScript.ShowTrayNotification(Title, Message: String; Timeout: Integer)', @_LapeShowTrayNotification); - - addGlobalFunc('function _TSimbaScript.GetSimbaPID: TProcessID', @_LapeGetSimbaPID); - addGlobalFunc('function _TSimbaScript.GetSimbaTargetPID: TProcessID', @_LapeGetSimbaTargetPID); - addGlobalFunc('function _TSimbaScript.GetSimbaTargetWindow: TWindowHandle', @_LapeGetSimbaTargetWindow); - - ImportingSection := ''; - end; -end; - -end. - diff --git a/Source/script/imports/simba.import_json.pas b/Source/script/imports/simba.import_json.pas index d1e01c084..9a9586c80 100644 --- a/Source/script/imports/simba.import_json.pas +++ b/Source/script/imports/simba.import_json.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportJson(Compiler: TSimbaScript_Compiler); +procedure ImportJson(Script: TSimbaScript); implementation @@ -647,11 +647,11 @@ procedure _LapeJSONParser_Keys_Read(const Params: PParamArray; const Result: Poi PStringArray(Result)^ := PSimbaJSONParser(Params^[0])^.Keys; end; -procedure ImportJSON(Compiler: TSimbaScript_Compiler); +procedure ImportJSON(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'JSON'; + DumpSection := 'JSON'; addGlobalType('enum(UNKNOWN, NULL, INT, FLOAT, STR, BOOL)', 'EJSONValueType'); with addGlobalType('record {%CODETOOLS OFF}InternalData: Pointer;{%CODETOOLS ON} end', 'TJSONElement') do @@ -717,8 +717,8 @@ procedure ImportJSON(Compiler: TSimbaScript_Compiler); addProperty('TJSONParser', 'Count', 'Integer', @_LapeJSONParser_Count_Read); addProperty('TJSONParser', 'AsString', 'String', @_LapeJSONParser_AsString_Read); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_matchtemplate.pas b/Source/script/imports/simba.import_matchtemplate.pas index 3b7f25f80..75323d68c 100644 --- a/Source/script/imports/simba.import_matchtemplate.pas +++ b/Source/script/imports/simba.import_matchtemplate.pas @@ -11,9 +11,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportMatchTemplate(Compiler: TSimbaScript_Compiler); +procedure ImportMatchTemplate(Script: TSimbaScript); implementation @@ -137,11 +137,11 @@ procedure _LapeMatchTemplateMask2(const Params: PParamArray; const Result: Point PSingleMatrix(Result)^ := MatchTemplateMask(PSimbaImage(Params^[0])^, PSimbaImage(Params^[1])^, PTMFormula(Params^[2])^); end; -procedure ImportMatchTemplate(Compiler: TSimbaScript_Compiler); +procedure ImportMatchTemplate(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Match Template'; + DumpSection := 'Match Template'; addClass('TMatchTemplateCache', 'TBaseClass'); addGlobalType('(TM_CCORR, TM_CCORR_NORMED, TM_CCOEFF, TM_CCOEFF_NORMED, TM_SQDIFF, TM_SQDIFF_NORMED)', 'ETMFormula'); @@ -160,8 +160,8 @@ procedure ImportMatchTemplate(Compiler: TSimbaScript_Compiler); addGlobalFunc('function MatchTemplateMask(Image, Template: TImage; Formula: ETMFormula): TSingleMatrix; overload', @_LapeMatchTemplateMask2); addGlobalFunc('function MatchTemplate(Image, Template: TImage; Formula: ETMFormula): TSingleMatrix; overload', @_LapeMatchTemplate2); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_math.pas b/Source/script/imports/simba.import_math.pas index 49a796762..bf3e229d2 100644 --- a/Source/script/imports/simba.import_math.pas +++ b/Source/script/imports/simba.import_math.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportMath(Compiler: TSimbaScript_Compiler); +procedure ImportMath(Script: TSimbaScript); implementation @@ -461,11 +461,11 @@ procedure _LapeIsNumberD(const Params: PParamArray; const Result: Pointer); LAPE PBoolean(Result)^ := IsNumber(PDouble(Params^[0])^); end; -procedure ImportMath(Compiler: TSimbaScript_Compiler); +procedure ImportMath(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Math'; + DumpSection := 'Math'; addGlobalVar(HALF_PI, 'HALF_PI').isConstant := True; addGlobalVar(SQRT_2, 'SQRT_2').isConstant := True; @@ -520,7 +520,7 @@ procedure ImportMath(Compiler: TSimbaScript_Compiler); addGlobalFunc('function PointInCircle(const P, Center: TPoint; Radius: Double): Boolean; static', @_LapePointInCircle); addGlobalFunc('function PointInEllipse(const P, Center: TPoint; const YRadius, XRadius: Double): Boolean', @_LapePointInEllipse); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_matrix.pas b/Source/script/imports/simba.import_matrix.pas index 6a27df6a5..cf6917b77 100644 --- a/Source/script/imports/simba.import_matrix.pas +++ b/Source/script/imports/simba.import_matrix.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportMatrix(Compiler: TSimbaScript_Compiler); +procedure ImportMatrix(Script: TSimbaScript); implementation @@ -611,11 +611,11 @@ procedure _LapeDoubleMatrix_GetSize(const Params: PParamArray; const Result: Poi PBoolean(Result)^ := PDoubleMatrix(Params^[0])^.GetSize(PInteger(Params^[1])^, PInteger(Params^[2])^); end; -procedure ImportMatrix(Compiler: TSimbaScript_Compiler); +procedure ImportMatrix(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Matrix'; + DumpSection := 'Matrix'; //addGlobalType('array of TSingleArray', 'TSingleMatrix'); //addGlobalType('array of TDoubleArray', 'TDoubleMatrix'); @@ -680,7 +680,7 @@ procedure ImportMatrix(Compiler: TSimbaScript_Compiler); addGlobalFunc('function TBooleanMatrix.Area: Integer;', @_LapeBooleanMatrix_Area); addGlobalFunc('function TBooleanMatrix.GetSize(out Width, Height: Integer): Boolean;', @_LapeBooleanMatrix_GetSize); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_misc.pas b/Source/script/imports/simba.import_misc.pas index 8c63cb60e..cd3dfebde 100644 --- a/Source/script/imports/simba.import_misc.pas +++ b/Source/script/imports/simba.import_misc.pas @@ -6,19 +6,23 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportMisc(Compiler: TSimbaScript_Compiler); +procedure ImportMisc(Script: TSimbaScript); implementation uses clipbrd, dialogs, lptypes, + simba.process, simba.nativeinterface, simba.settings, simba.compress, simba.env, simba.aca, simba.dtmeditor, simba.dialog, simba.threading, simba.target, simba.colormath, simba.finder_color, simba.finder_image, simba.matchtemplate; +type + PProcessID = ^TProcessID; + (* Misc ==== @@ -325,6 +329,15 @@ procedure _LapeShowQuestionDialog(const Params: PParamArray; const Result: Point procedure ShowTrayNotification(Title, Message: String; Timeout: Integer = 3000); ``` *) +procedure _LapeShowTrayNotfication(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('ShowTrayNotification requires Simba communication'); + SimbaCommunication.ShowTrayNotification(PString(Params^[1])^, PString(Params^[2])^, PInteger(Params^[3])^); + end; +end; (* SetSimbaTitle @@ -333,6 +346,15 @@ procedure ShowTrayNotification(Title, Message: String; Timeout: Integer = 3000); procedure SetSimbaTitle(S: String); ``` *) +procedure _LapeSetSimbaTitle(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('SetSimbaTitle requires Simba communication'); + SimbaCommunication.SetSimbaTitle(PString(Params^[1])^); + end; +end; (* GetSimbaPID @@ -343,6 +365,15 @@ function GetSimbaPID: TProcessID; Returns the Simba's PID this script is running in. *) +procedure _LapeGetSimbaPID(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('GetSimbaPID requires Simba communication'); + PProcessID(Result)^ := SimbaCommunication.GetSimbaTargetPID(); + end; +end; (* GetSimbaTargetPID @@ -353,6 +384,15 @@ function GetSimbaTargetPID: TProcessID; Returns the current Simba target PID (what is selected with the crosshair) *) +procedure _LapeGetSimbaTargetPID(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('GetSimbaTargetPID requires Simba communication'); + PProcessID(Result)^ := SimbaCommunication.GetSimbaTargetPID(); + end; +end; (* GetSimbaTargetWindow @@ -363,6 +403,15 @@ function GetSimbaTargetWindow: TWindowHandle; Returns the current Simba target window (what is selected with the crosshair) *) +procedure _LapeGetSimbaTargetWindow(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + with TSimbaScript(Params^[0]) do + begin + if (SimbaCommunication = nil) then + SimbaException('GetSimbaTargetWindow requires Simba communication'); + PWindowHandle(Result)^ := SimbaCommunication.GetSimbaTargetWindow(); + end; +end; (* SaveScreenshot @@ -390,8 +439,6 @@ function SaveScreenshot(FileName: String): String; -------------- ``` procedure AddOnTerminate(Proc: procedure); -``` -``` procedure AddOnTerminate(Proc: procedure of object); ``` @@ -403,8 +450,6 @@ procedure AddOnTerminate(Proc: procedure of object); ------------------ ``` procedure AddOnUserTerminate(Proc: procedure); -``` -``` procedure AddOnUserTerminate(Proc: procedure of object); ``` @@ -416,8 +461,6 @@ procedure AddOnUserTerminate(Proc: procedure of object); ---------- ``` procedure AddOnPause(Proc: procedure); -``` -``` procedure AddOnPause(Proc: procedure of object); ``` @@ -429,8 +472,6 @@ procedure AddOnPause(Proc: procedure of object); ----------- ``` procedure AddOnResume(Proc: procedure); -``` -``` procedure AddOnResume(Proc: procedure of object); ``` @@ -442,8 +483,6 @@ procedure AddOnResume(Proc: procedure of object); ----------- ``` procedure AddOnResume(Proc: procedure); -``` -``` procedure AddOnResume(Proc: procedure of object); ``` @@ -455,12 +494,10 @@ procedure AddOnResume(Proc: procedure of object); --------------- ``` procedure TerminateScript; -``` -``` procedure TerminateScript(Reason: String); ``` -Instantly terminates the script! +Terminates the script on the next operation. *) (* @@ -472,12 +509,16 @@ procedure PauseScript; Programmatically pauses the script. The only way for the script to resumed is by the user clicking the play button. *) +procedure _LapePauseScript(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + TSimbaScript(Params^[0]).State := ESimbaScriptState.STATE_PAUSED; +end; -procedure ImportMisc(Compiler: TSimbaScript_Compiler); +procedure ImportMisc(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Misc'; + DumpSection := 'Misc'; addGlobalVar('record Enabled: Boolean; SliceWidth, SliceHeight: Integer; end;', @ColorFinderMultithreadOpts, 'ColorFinderMultithreadOpts'); addGlobalVar('record Enabled: Boolean; SliceWidth, SliceHeight: Integer; end;', @ImageFinderMultithreadOpts, 'ImageFinderMultithreadOpts'); @@ -495,9 +536,9 @@ procedure ImportMisc(Compiler: TSimbaScript_Compiler); 'end;' ], 'SimbaEnv'); - // Assigned later in `TSimbaScript.Run` - addGlobalVar('String', '', 'SCRIPT_FILE').isConstant := True; - addGlobalVar('UInt64', '0', 'SCRIPT_START_TIME').isConstant := True; + + addGlobalVar(Script.ScriptFileName, 'SCRIPT_FILE').isConstant := True; + addGlobalVar(GetTickCount64(), 'SCRIPT_START_TIME').isConstant := True; addGlobalFunc( 'function GetTimeRunning: UInt64;', [ @@ -506,58 +547,28 @@ procedure ImportMisc(Compiler: TSimbaScript_Compiler); 'end;' ]); - addGlobalFunc( - 'procedure PauseScript;', [ - 'begin', - ' _SimbaScript.Pause();', - 'end;' - ]); + addGlobalMethod('procedure PauseScript;', @_LapePauseScript, Script); + addGlobalMethod('function GetSimbaPID: TProcessID;', @_LapeGetSimbaPID, Script); + addGlobalMethod('function GetSimbaTargetPID: TProcessID;', @_LapeGetSimbaTargetPID, Script); + addGlobalMethod('function GetSimbaTargetWindow: TWindowHandle;', @_LapeGetSimbaTargetWindow, Script); + addGlobalMethod('procedure SetSimbaTitle(S: String);', @_LapeSetSimbaTitle, Script); + addGlobalMethod('procedure ShowTrayNotification(Title, Message: String; Timeout: Integer = 3000);', @_LapeShowTrayNotfication, Script); addGlobalFunc( - 'procedure TerminateScript(WriteCallStack: Boolean = False); overload;', [ + 'procedure TerminateScript; overload;', [ 'begin', - ' WriteLn("Script Terminated");', - ' if WriteCallStack then', - ' WriteLn(DumpCallStack(1));', ' Halt();', 'end;' ]); addGlobalFunc( - 'procedure TerminateScript(Reason: String; WriteCallStack: Boolean = False); overload;', [ + 'procedure TerminateScript(Reason: String); overload;', [ 'begin', ' WriteLn("Script Terminated: " + Reason);', - ' if WriteCallStack then', - ' WriteLn(DumpCallStack(1));', - ' Halt();', - 'end;' - ]); - - addGlobalFunc( - 'procedure SetSimbaTitle(S: String);', [ - 'begin', - ' _SimbaScript.SetSimbaTitle(S);', + ' TerminateScript();', 'end;' ]); - addGlobalFunc( - 'function GetSimbaPID: TProcessID;', [ - 'begin', - ' Result := _SimbaScript.GetSimbaPID();', - 'end;' - ]); - addGlobalFunc( - 'function GetSimbaTargetPID: TProcessID;', [ - 'begin', - ' Result := _SimbaScript.GetSimbaTargetPID();', - 'end;' - ]); - addGlobalFunc( - 'function GetSimbaTargetWindow: TWindowHandle;', [ - 'begin', - ' Result := _SimbaScript.GetSimbaTargetWindow();', - 'end;' - ]); addGlobalFunc('procedure ClearSimbaOutput', @ClearSimbaOutput); addGlobalFunc('function SetSimbaSetting(Name: String; DefValue: String = ""): String', @_LapeGetSimpleSetting); addGlobalFunc('procedure GetSimbaSetting(Name, Value: String);', @_LapeSetSimpleSetting); @@ -589,13 +600,6 @@ procedure ImportMisc(Compiler: TSimbaScript_Compiler); 'end;' ]); - addGlobalFunc( - 'procedure ShowTrayNotification(Title, Message: String; Timeout: Integer = 3000);', [ - 'begin', - ' _SimbaScript.ShowTrayNotification(Title, Message, Timeout);', - 'end;' - ]); - addGlobalFunc( 'function SaveScreenshot: String; overload;', [ 'var', @@ -730,7 +734,7 @@ procedure ImportMisc(Compiler: TSimbaScript_Compiler); 'end;' ]); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_point.pas b/Source/script/imports/simba.import_point.pas index 04c8525c7..1ce4acdeb 100644 --- a/Source/script/imports/simba.import_point.pas +++ b/Source/script/imports/simba.import_point.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportPoint(Compiler: TSimbaScript_Compiler); +procedure ImportPoint(Script: TSimbaScript); implementation @@ -300,11 +300,11 @@ procedure _LapePoint_IN_Box(const Params: PParamArray; const Result: Pointer); L PBoolean(Result)^ := PPoint(Params^[0])^ in PBox(Params^[1])^; end; -procedure ImportPoint(Compiler: TSimbaScript_Compiler); +procedure ImportPoint(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'TPoint'; + DumpSection := 'TPoint'; addGlobalFunc('function Point(X, Y: Integer): TPoint', @_LapePoint); @@ -333,8 +333,8 @@ procedure ImportPoint(Compiler: TSimbaScript_Compiler); addGlobalFunc('operator *= (var L: TPoint; R: Double): TPoint;', @_LapePoint_MultiplyAssign_Double); addGlobalFunc('operator in(Left: TPoint; Right: TBox): Boolean;', @_LapePoint_IN_Box); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_pointbuffer.pas b/Source/script/imports/simba.import_pointbuffer.pas index eac5a0454..fb159ba5f 100644 --- a/Source/script/imports/simba.import_pointbuffer.pas +++ b/Source/script/imports/simba.import_pointbuffer.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportPointBuffer(Compiler: TSimbaScript_Compiler); +procedure ImportPointBuffer(Script: TSimbaScript); implementation @@ -84,9 +84,9 @@ procedure _LapePointBuffer_Point(const Params: PParamArray; const Result: Pointe PPoint(Result)^ := PSimbaPointBuffer(Params^[0])^.Item[PInteger(Params^[1])^]; end; -procedure ImportPointBuffer(Compiler: TSimbaScript_Compiler); +procedure ImportPointBuffer(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addGlobalType([ 'record', diff --git a/Source/script/imports/simba.import_process.pas b/Source/script/imports/simba.import_process.pas index d72e0fa3e..525806f4e 100644 --- a/Source/script/imports/simba.import_process.pas +++ b/Source/script/imports/simba.import_process.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, Forms, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportProcess(Compiler: TSimbaScript_Compiler); +procedure ImportProcess(Script: TSimbaScript); implementation @@ -452,11 +452,11 @@ procedure _LapeStartSimbaScriptPiped(const Params: PParamArray; const Result: Po PRunningProcessPiped(Result)^ := StartScriptPiped(PString(Params^[0])^, PStringArray(Params^[1])^); end; -procedure ImportProcess(Compiler: TSimbaScript_Compiler); +procedure ImportProcess(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Process'; + DumpSection := 'Process'; addGlobalType('type Integer', 'TProcessID'); addGlobalType('type Integer', 'TProcessExitCode'); @@ -506,7 +506,7 @@ procedure ImportProcess(Compiler: TSimbaScript_Compiler); addGlobalFunc('function StartSimbaScript(Script: String; Params: TStringArray): TRunningProcess', @_LapeStartSimbaScript); addGlobalFunc('function StartSimbaScriptPiped(Script: String; Params: TStringArray): TRunningProcessPiped', @_LapeStartSimbaScriptPiped); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_quad.pas b/Source/script/imports/simba.import_quad.pas index 490bbbc3f..589348ce9 100644 --- a/Source/script/imports/simba.import_quad.pas +++ b/Source/script/imports/simba.import_quad.pas @@ -11,9 +11,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportQuad(Compiler: TSimbaScript_Compiler); +procedure ImportQuad(Script: TSimbaScript); implementation @@ -282,11 +282,11 @@ procedure _LapeQuad_IN_Quad(const Params: PParamArray; const Result: Pointer); L PBoolean(Result)^ := PPoint(Params^[0])^ in PQuad(Params^[1])^; end; -procedure ImportQuad(Compiler: TSimbaScript_Compiler); +procedure ImportQuad(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'TQuad'; + DumpSection := 'TQuad'; addGlobalFunc('function TQuad.Create(ATop, ARight, ABottom, ALeft: TPoint): TQuad; static; overload', @_LapeQuad_Create); addGlobalFunc('function TQuad.CreateFromBox(Box: TBox): TQuad; static; overload', @_LapeQuad_CreateFromBox); @@ -312,8 +312,8 @@ procedure ImportQuad(Compiler: TSimbaScript_Compiler); addGlobalFunc('operator in(Left: TPoint; Right: TQuad): Boolean;', @_LapeQuad_IN_Quad); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_random.pas b/Source/script/imports/simba.import_random.pas index 705b25625..21421c8f4 100644 --- a/Source/script/imports/simba.import_random.pas +++ b/Source/script/imports/simba.import_random.pas @@ -20,9 +20,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportRandom(Compiler: TSimbaScript_Compiler); +procedure ImportRandom(Script: TSimbaScript); implementation @@ -245,11 +245,11 @@ procedure _LapeRandomize(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV BetterRandomize(); end; -procedure ImportRandom(Compiler: TSimbaScript_Compiler); +procedure ImportRandom(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Random'; + DumpSection := 'Random'; addGlobalVar(ltDouble, @RandCutoff, 'RandCutoff'); @@ -273,8 +273,8 @@ procedure ImportRandom(Compiler: TSimbaScript_Compiler); addGlobalFunc('function GaussRand(Mean, Dev: Double): Double;', @_LapeGaussRand); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_shapebox.pas b/Source/script/imports/simba.import_shapebox.pas index aba55095c..599946683 100644 --- a/Source/script/imports/simba.import_shapebox.pas +++ b/Source/script/imports/simba.import_shapebox.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportSimbaShapeBox(Compiler: TSimbaScript_Compiler); +procedure ImportSimbaShapeBox(Script: TSimbaScript); implementation @@ -202,9 +202,9 @@ procedure _LapeSimbaShapeBox_SelectedIndex_Write(const Params: PParamArray); LAP PSimbaShapeBox(Params^[0])^.SelectedIndex := PInteger(Params^[1])^; end; -procedure ImportSimbaShapeBox(Compiler: TSimbaScript_Compiler); +procedure ImportSimbaShapeBox(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addClass('TShapeBox', 'TImageBox'); diff --git a/Source/script/imports/simba.import_slacktree.pas b/Source/script/imports/simba.import_slacktree.pas index c82de47e8..7c4be1aa9 100644 --- a/Source/script/imports/simba.import_slacktree.pas +++ b/Source/script/imports/simba.import_slacktree.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportSlackTree(Compiler: TSimbaScript_Compiler); +procedure ImportSlackTree(Script: TSimbaScript); implementation @@ -86,9 +86,9 @@ procedure _LapeSlackTreeRefArray(const Params: PParamArray; const Result: Pointe TNodeRefArray(Result^) := PSlackTree(Params^[0])^.RefArray; end; -procedure ImportSlackTree(Compiler: TSimbaScript_Compiler); +procedure ImportSlackTree(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin addGlobalType('record Split: TPoint; L, R: Integer; hidden: Boolean; end;', 'TSlackNode'); addGlobalType('^TSlackNode', 'PSlackNode'); diff --git a/Source/script/imports/simba.import_string.pas b/Source/script/imports/simba.import_string.pas index a9d5edc01..8631aca9f 100644 --- a/Source/script/imports/simba.import_string.pas +++ b/Source/script/imports/simba.import_string.pas @@ -7,9 +7,9 @@ interface uses Classes, SysUtils, lptypes, lpvartypes, - simba.base, simba.script_compiler, simba.vartype_string, simba.vartype_stringarray; + simba.base, simba.script, simba.vartype_string, simba.vartype_stringarray; -procedure ImportString(Compiler: TSimbaScript_Compiler); +procedure ImportString(Script: TSimbaScript); implementation @@ -1122,11 +1122,11 @@ procedure _LapeStringArray_ToString(const Params: PParamArray; const Result: Poi PString(Result)^ := PStringArray(Params^[0])^.ToString(PString(Params^[1])^); end; -procedure ImportString(Compiler: TSimbaScript_Compiler); +procedure ImportString(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'String'; + DumpSection := 'String'; addGlobalType( 'record' + LineEnding + @@ -1269,7 +1269,7 @@ procedure ImportString(Compiler: TSimbaScript_Compiler); addGlobalFunc('operator in(Left: Char; Right: String): Boolean', @_LapeChar_IN_String); addGlobalFunc('operator in(Left: Char; Right: TStringArray): Boolean', @_LapeChar_IN_StringArray); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_target.pas b/Source/script/imports/simba.import_target.pas index 391cd54e4..8abb75939 100644 --- a/Source/script/imports/simba.import_target.pas +++ b/Source/script/imports/simba.import_target.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportTarget(Compiler: TSimbaScript_Compiler); +procedure ImportTarget(Script: TSimbaScript); implementation @@ -1095,11 +1095,11 @@ procedure _LapeFinder_PeakBrightness(const Params: PParamArray; const Result: Po PInteger(Result)^ := PSimbaTarget(Params^[0])^.PeakBrightness(PBox(Params^[1])^); end; -procedure ImportTarget(Compiler: TSimbaScript_Compiler); +procedure ImportTarget(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Target'; + DumpSection := 'Target'; addGlobalType([ 'record', @@ -1271,7 +1271,7 @@ procedure ImportTarget(Compiler: TSimbaScript_Compiler); 'end;' ]); - ImportingSection := 'Image'; + DumpSection := 'Image'; addGlobalFunc( 'function TImage.CreateFromTarget(Target: TTarget; Bounds: TBox = [-1,-1,-1,-1]): TImage; static; overload;', [ @@ -1303,7 +1303,7 @@ procedure ImportTarget(Compiler: TSimbaScript_Compiler); 'end;' ]); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_threading.pas b/Source/script/imports/simba.import_threading.pas index df32af205..e98d6935b 100644 --- a/Source/script/imports/simba.import_threading.pas +++ b/Source/script/imports/simba.import_threading.pas @@ -11,9 +11,9 @@ interface uses Classes, SysUtils, - simba.base, simba.vartype_string, simba.script_compiler, simba.script_threading; + simba.base, simba.script, simba.vartype_string, simba.script_threading; -procedure ImportThreading(Compiler: TSimbaScript_Compiler); +procedure ImportThreading(Script: TSimbaScript); implementation @@ -314,11 +314,11 @@ procedure RunInThreadEx(Method: procedure(Params: TPointerArray) of object; OnTe ``` *) -procedure ImportThreading(Compiler: TSimbaScript_Compiler); +procedure ImportThreading(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Threading'; + DumpSection := 'Threading'; addGlobalVar( 'record' + LineEnding + @@ -351,7 +351,7 @@ procedure ImportThreading(Compiler: TSimbaScript_Compiler); addGlobalFunc('function CurrentThread: TThread', @_LapeCurrentThread); - ImportingSection := '!Hidden'; + DumpSection := '!Hidden'; addGlobalVar(Emitter, '_CodeEmitter').isConstant := True; addGlobalFunc('function _CreateThread(Emitter: Pointer; Method: procedure of object; OnTerminate: procedure(Thread: TThread) of object): TThread;', @_LapeCreateThread); @@ -427,7 +427,7 @@ procedure ImportThreading(Compiler: TSimbaScript_Compiler); 'end;' ]); - ImportingSection := 'Threading'; + DumpSection := 'Threading'; addGlobalFunc( 'function TThread.Create(Method: procedure of object): TThread; static; overload;', [ @@ -491,7 +491,7 @@ procedure ImportThreading(Compiler: TSimbaScript_Compiler); 'end;' ]); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_tpa.pas b/Source/script/imports/simba.import_tpa.pas index 7913dc92b..c10b62233 100644 --- a/Source/script/imports/simba.import_tpa.pas +++ b/Source/script/imports/simba.import_tpa.pas @@ -11,9 +11,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportTPA(Compiler: TSimbaScript_Compiler); +procedure ImportTPA(Script: TSimbaScript); implementation @@ -907,11 +907,11 @@ procedure _LapeTPAToAxes(const Params: PParamArray; const Result: Pointer); LAPE PPointArray(Params^[0])^.ToAxes(PIntegerArray(Params^[1])^, PIntegerArray(Params^[2])^); end; -procedure ImportTPA(Compiler: TSimbaScript_Compiler); +procedure ImportTPA(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'TPointArray'; + DumpSection := 'TPointArray'; addGlobalFunc('function TPointArray.CreateFromBox(Box: TBox; Filled: Boolean): TPointArray; static;', @_LapeTPACreateFromBox); addGlobalFunc('function TPointArray.CreateFromEllipse(Center: TPoint; RadiusX, RadiusY: Integer; Filled: Boolean): TPointArray; static;', @_LapeTPACreateFromEllipse); @@ -1008,7 +1008,7 @@ procedure ImportTPA(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TPointArray.ToAxes(out X, Y: TIntegerArray);', @_LapeTPAToAxes); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_variant.pas b/Source/script/imports/simba.import_variant.pas index 675ad389e..bcf523bc9 100644 --- a/Source/script/imports/simba.import_variant.pas +++ b/Source/script/imports/simba.import_variant.pas @@ -15,7 +15,7 @@ interface Classes, SysUtils, simba.base, simba.script_compiler; -procedure ImportVariant(Compiler: TSimbaScript_Compiler); +procedure ImportVariant(Script: TSimbaScript); implementation @@ -190,11 +190,11 @@ procedure _LapeVariantNULL(const Params: PParamArray; const Result: Pointer); LA PVariant(Result)^ := Null; end; -procedure ImportVariant(Compiler: TSimbaScript_Compiler); +procedure ImportVariant(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Variant'; + DumpSection := 'Variant'; addGlobalType('enum(Unknown, Unassigned, Null, Int8, Int16, Int32, Int64, UInt8, UInt16, UInt32, UInt64, Single, Double, DateTime, Currency, Boolean, Variant, AString, UString, WString)', 'EVariantVarType'); @@ -211,7 +211,7 @@ procedure ImportVariant(Compiler: TSimbaScript_Compiler); addGlobalFunc('function Variant.NULL: Variant; static;', @_LapeVariantNULL); - ImportingSection := ''; + DumpSection := ''; end; end; diff --git a/Source/script/imports/simba.import_web.pas b/Source/script/imports/simba.import_web.pas index 954995804..d1933de56 100644 --- a/Source/script/imports/simba.import_web.pas +++ b/Source/script/imports/simba.import_web.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportWeb(Compiler: TSimbaScript_Compiler); +procedure ImportWeb(Script: TSimbaScript); implementation @@ -900,11 +900,11 @@ procedure _LapeLoadSSL(const Params: PParamArray; const Result: Pointer); LAPE_W PBoolean(Result)^ := LoadSSL(PBoolean(Params^[0])^); end; -procedure ImportWeb(Compiler: TSimbaScript_Compiler); +procedure ImportWeb(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'Web'; + DumpSection := 'Web'; addGlobalType(specialize GetEnumDecl(True, True), 'EHTTPStatus'); addGlobalFunc('property EHTTPStatus.AsInteger: Integer', @_LapeHTTPStatus_AsInteger_Read); @@ -959,7 +959,7 @@ procedure ImportWeb(Compiler: TSimbaScript_Compiler); TSimbaHTTPClient(Ptr^).FreeOnTerminate := True end; - ImportingSection := ''; + DumpSection := ''; addClass('TInternetSocket'); addGlobalFunc('function TInternetSocket.Create(AHost: String; APort: UInt16; UseSSL: Boolean = False): TInternetSocket; static;', @_LapeSimbaInternetSocket_Create); @@ -1005,4 +1005,4 @@ procedure ImportWeb(Compiler: TSimbaScript_Compiler); end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/imports/simba.import_windowhandle.pas b/Source/script/imports/simba.import_windowhandle.pas index 9db3eaf62..9b25e673a 100644 --- a/Source/script/imports/simba.import_windowhandle.pas +++ b/Source/script/imports/simba.import_windowhandle.pas @@ -6,9 +6,9 @@ interface uses Classes, SysUtils, - simba.base, simba.script_compiler; + simba.base, simba.script; -procedure ImportWindowHandle(Compiler: TSimbaScript_Compiler); +procedure ImportWindowHandle(Script: TSimbaScript); implementation @@ -324,11 +324,11 @@ procedure _LapeFindChildWindows(const Params: PParamArray; const Result: Pointer PWindowHandleArray(Result)^ := FindChildWindows(PString(Params^[0])^, PString(Params^[1])^); end; -procedure ImportWindowHandle(Compiler: TSimbaScript_Compiler); +procedure ImportWindowHandle(Script: TSimbaScript); begin - with Compiler do + with Script.Compiler do begin - ImportingSection := 'TWindowHandle'; + DumpSection := 'TWindowHandle'; addGlobalType('type UInt64', 'TWindowHandle'); addGlobalType('array of TWindowHandle', 'TWindowHandleArray'); @@ -358,8 +358,8 @@ procedure ImportWindowHandle(Compiler: TSimbaScript_Compiler); addGlobalFunc('function FindChildWindow(Title: String; ClassName: String; out Child: TWindowHandle): Boolean; overload', @_LapeFindChildWindow); addGlobalFunc('function FindChildWindows(Title: String; ClassName: String): TWindowHandleArray; overload', @_LapeFindChildWindows); - ImportingSection := ''; + DumpSection := ''; end; end; -end. \ No newline at end of file +end. diff --git a/Source/script/simba.compiler_dump.pas b/Source/script/simba.compiler_dump.pas deleted file mode 100644 index 2640fea7c..000000000 --- a/Source/script/simba.compiler_dump.pas +++ /dev/null @@ -1,362 +0,0 @@ -{ - Author: Raymond van Venetië and Merlijn Wajer - Project: Simba (https://github.com/MerlijnWajer/Simba) - License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0) - - Overrides import methods to gather declarations. -} -unit simba.compiler_dump; - -{$i simba.inc} - -interface - -uses - Classes, SysUtils; - -procedure DumpCompiler(FileName: String); - -implementation - -uses - lpparser, lptypes, lpvartypes, lptree, - simba.base, simba.script_compiler, simba.containers; - -type - TSimbaCompilerDump = class(TSimbaScript_Compiler) - protected - FItems: TSimbaStringPairList; - - procedure InitBaseVariant; override; - procedure InitBaseDefinitions; override; - procedure InitBaseFile; override; - - procedure Add(Section, Str: String); - procedure AddMethod(Str: String); - procedure AddType(Name, Str: String); - procedure AddCode(Str: String; EnsureSemicolon: Boolean = True); - - procedure Move(Str, FromSection, ToSection: String); - procedure Del(Str, Section: String); - public - constructor Create(ATokenizer: TLapeTokenizerBase; ManageTokenizer: Boolean=True; AEmitter: TLapeCodeEmitter = nil; ManageEmitter: Boolean = True); reintroduce; override; - destructor Destroy; override; - - procedure addBaseDefine(Define: lpString; Value: lpString = ''); override; - - function addDelayedCode(ACode: lpString; AFileName: lpString = ''; AfterCompilation: Boolean = True; IsGlobal: Boolean = True): TLapeTree_Base; override; - - function addGlobalFunc(Header: lpString; Value: Pointer): TLapeGlobalVar; override; - function addGlobalFunc(Header: lpString; Body: TStringArray): TLapeTree_Method; override; - - function addGlobalType(Typ: TLapeType; AName: lpString; ACopy: Boolean): TLapeType; override; - function addGlobalType(Str: lpString; AName: lpString): TLapeType; override; - - function addGlobalVar(Typ: lpString; Value: Pointer; AName: lpString): TLapeGlobalVar; override; - function addGlobalVar(Typ: lpString; Value: lpString; AName: lpString): TLapeGlobalVar; override; - function addGlobalVar(AVar: TLapeGlobalVar; AName: lpString = ''): TLapeGlobalVar; override; - - procedure DumpToFile(FileName: String); - end; - -procedure DumpCompiler(FileName: String); -begin - with TSimbaCompilerDump.Create(TLapeTokenizerString.Create('begin end')) do - try - DumpToFile(FileName); - finally - Free(); - end; -end; - -procedure TSimbaCompilerDump.InitBaseVariant; -begin - { nothing, we import our own variant } -end; - -procedure TSimbaCompilerDump.InitBaseDefinitions; -var - BaseType: ELapeBaseType; -begin - ImportingSection := 'Base'; - - // Base types - for BaseType in ELapeBaseType do - if (FBaseTypes[BaseType] <> nil) then - Add('Base', 'type %s = %s;'.Format([LapeTypeToString(BaseType), LapeTypeToString(BaseType)])); - - inherited InitBaseDefinitions(); - - // add internal methods - Add('Base', 'procedure Delete(A: array; Index: Int32; Count: Int32 = Length(A)); external;'); - Add('Base', 'procedure Insert(Item: Anything; A: array; Index: Int32); external;'); - Add('Base', 'procedure Copy(A: array; Index: Int32 = 0; Count: Int32 = Length(A)); overload; external;'); - Add('Base', 'procedure SetLength(A: array; Length: Int32); overload; external;'); - Add('Base', 'function Low(A: array): Int32; external;'); - Add('Base', 'function High(A: array): Int32; external;'); - Add('Base', 'function Length(A: array): Int32; overload; external;'); - Add('Base', 'procedure WriteLn(Args: Anything); external;'); - Add('Base', 'procedure Write(Args: Anything); external;'); - Add('Base', 'procedure Swap(var A, B: Anything); external;'); - Add('Base', 'function SizeOf(A: Anything): Int32; external;'); - Add('Base', 'function ToString(A: Anything): String; external;'); - Add('Base', 'function ToStr(A: Anything): String; external;'); - Add('Base', 'function Inc(var X: Ordinal; Amount: SizeInt = 1): Ordinal; overload; external;'); - Add('Base', 'function Dec(var X: Ordinal; Amount: SizeInt = 1): Ordinal; overload; external;'); - Add('Base', 'function Ord(X: Ordinal): Int32; external;'); - Add('Base', 'function SleepUntil(Condition: BoolExpr; Interval, Timeout: Int32): Boolean; external;'); - Add('Base', 'function Default(T: AnyType): AnyType; external;'); - Add('Base', 'procedure Sort(var A: array); overload; external;'); - Add('Base', 'procedure Sort(var A: array; Weights: array of Ordinal; LowToHigh: Boolean); overload; external;'); - Add('Base', 'procedure Sort(var A: array; CompareFunc: function(constref L, R: Anything): Int32); overload; external;'); - Add('Base', 'function Sorted(const A: array): array; overload; external;'); - Add('Base', 'function Sorted(const A: array; CompareFunc: function(constref L, R: Anything): Int32): array; overload; external;'); - Add('Base', 'function Sorted(const A: array; Weights: array of Ordinal; LowToHigh: Boolean): array; overload; external;'); - Add('Base', 'function Unique(const A: array): array; external;'); - Add('Base', 'procedure Reverse(var A: array); external;'); - Add('Base', 'function Reversed(const A: array): array; external;'); - Add('Base', 'function IndexOf(const Item: T; const A: array): Integer; external;'); - Add('Base', 'function IndicesOf(const Item: T; const A: array): TIntegerArray; external;'); - Add('Base', 'function Contains(const Item: T; const A: array): Boolean; external;'); - Add('Base', 'function RTTIFields(constref RecordTypeOrVar): TRTTIFields; external;'); - - Add('Base', 'function GetCallerAddress: Pointer; external;'); - Add('Base', 'function GetCallerName: String; external;'); - Add('Base', 'function GetCallerLocation: Pointer; external;'); - Add('Base', 'function GetCallerLocationStr: String; external;'); - - Add('Base', 'function GetExceptionLocation: Pointer; external;'); - Add('Base', 'function GetExceptionLocationStr: String; external;'); - Add('Base', 'function GetExceptionMessage: String; external;'); - - Add('Base', 'function GetScriptMethodName(Address: Pointer): String; external;'); - Add('Base', 'function DumpCallStack(Start: Integer = 0): String; external;'); - - Add('Base', 'function Map(KeyType: T; ValueType: V): Map; external;'); - Add('Base', 'function StringMap(ValueType: V): StringMap; external;'); - Add('Base', 'function Heap(ValueType: V): Heap; external;'); - - ImportingSection := ''; -end; - -procedure TSimbaCompilerDump.InitBaseFile; -begin - ImportingSection := 'File'; - inherited InitBaseFile(); - ImportingSection := ''; -end; - -procedure TSimbaCompilerDump.Add(Section, Str: String); -var - Item: TSimbaStringPair; -begin - if (Section = '!Hidden') then - Exit; - - Item.Name := Section; - Item.Value := Str; - - FItems.Add(Item); -end; - -procedure TSimbaCompilerDump.Move(Str, FromSection, ToSection: String); -var - I: Integer; - Item: TSimbaStringPair; -begin - for I := 0 to FItems.Count - 1 do - if (FItems[I].Name = FromSection) and FItems[I].Value.StartsWith(Str) then - begin - Item := FItems[I]; - Item.Name := ToSection; - - FItems[I] := Item; - end; -end; - -procedure TSimbaCompilerDump.Del(Str, Section: String); -var - I: Integer; -begin - for I := 0 to FItems.Count - 1 do - if (FItems[I].Name = Section) and FItems[I].Value.StartsWith(Str) then - begin - FItems.Delete(I); - Exit; - end; -end; - -procedure TSimbaCompilerDump.AddMethod(Str: String); -begin - Str := Str.Trim(); - if not Str.EndsWith(';') then - Str := Str + ';'; - Str := Str + ' external;'; - - Add(ImportingSection, Str); -end; - -procedure TSimbaCompilerDump.AddType(Name, Str: String); -begin - if Name.StartsWith('!') then - Exit; - - Str := 'type ' + Name + ' = ' + Str; - if not Str.EndsWith(';') then - Str := Str + ';'; - - Add(ImportingSection, Str); -end; - -procedure TSimbaCompilerDump.AddCode(Str: String; EnsureSemicolon: Boolean); -begin - if EnsureSemicolon and (not Str.EndsWith(';')) then - Str := Str + ';'; - - Add(ImportingSection, Str); -end; - -constructor TSimbaCompilerDump.Create(ATokenizer: TLapeTokenizerBase; ManageTokenizer: Boolean; AEmitter: TLapeCodeEmitter; ManageEmitter: Boolean); -begin - FItems := TSimbaStringPairList.Create(); - - inherited Create(ATokenizer, ManageTokenizer, AEmitter, ManageEmitter); -end; - -destructor TSimbaCompilerDump.Destroy; -begin - if (FItems <> nil) then - FreeAndNil(FItems); - - inherited Destroy(); -end; - -procedure TSimbaCompilerDump.addBaseDefine(Define: lpString; Value: lpString); -begin - inherited addBaseDefine(Define, Value); - - AddCode('{$DEFINE ' + Define + '}', False); -end; - -function TSimbaCompilerDump.addDelayedCode(ACode: lpString; AFileName: lpString; AfterCompilation: Boolean; IsGlobal: Boolean): TLapeTree_Base; -begin - Result := inherited addDelayedCode(ACode, AFileName, AfterCompilation, IsGlobal); - - if (not AFileName.StartsWith('!')) then - AddCode(ACode); -end; - -function TSimbaCompilerDump.addGlobalFunc(Header: lpString; Value: Pointer): TLapeGlobalVar; -begin - Result := inherited addGlobalFunc(Header, Value); - - AddMethod(Header); -end; - -function TSimbaCompilerDump.addGlobalFunc(Header: lpString; Body: TStringArray): TLapeTree_Method; -begin - Result := inherited addGlobalFunc(Header, Body); - - AddMethod(Header); -end; - -function TSimbaCompilerDump.addGlobalType(Typ: TLapeType; AName: lpString; ACopy: Boolean): TLapeType; -begin - if (Typ.Name <> '') then - begin - AddType(AName, Typ.Name); - Result := inherited addGlobalType(Typ, AName, ACopy); - end else - begin - Result := inherited addGlobalType(Typ, AName, ACopy); - AddType(AName, Typ.Name); - end; -end; - -function TSimbaCompilerDump.addGlobalType(Str: lpString; AName: lpString): TLapeType; -begin - Result := inherited addGlobalType(Str, AName); - - AddType(AName, Str); -end; - -function TSimbaCompilerDump.addGlobalVar(Typ: lpString; Value: Pointer; AName: lpString): TLapeGlobalVar; -begin - Result := inherited addGlobalVar(Typ, Value, AName); - Result._DocPos.FileName := ImportingSection; - - if (AName <> '') and (Result.VarType.Name = '') then - AddCode('var ' + AName + ': ' + Typ); -end; - -function TSimbaCompilerDump.addGlobalVar(Typ: lpString; Value: lpString; AName: lpString): TLapeGlobalVar; -begin - Result := inherited addGlobalVar(Typ, Value, AName); - Result._DocPos.FileName := ImportingSection; -end; - -function TSimbaCompilerDump.addGlobalVar(AVar: TLapeGlobalVar; AName: lpString): TLapeGlobalVar; -begin - Result := inherited addGlobalVar(AVar, AName); - Result._DocPos.FileName := ImportingSection; -end; - -procedure TSimbaCompilerDump.DumpToFile(FileName: String); -var - Decl: TLapeDeclaration; - I: Integer; - Str: String; -begin - Import(); - - // Variables & Constants - for Decl in FGlobalDeclarations.GetByClass(TLapeGlobalVar, bTrue) do - with TLapeGlobalVar(Decl) do - begin - if (Name = '') or (VarType = nil) or (VarType.Name = '') or (BaseType in [ltUnknown, ltScriptMethod, ltImportedMethod]) then - Continue; - if DocPos.FileName.StartsWith('!') then - Continue; - - if IsConstant then - Str := 'const ' + UpperCase(Name) + ': ' + VarType.Name - else - Str := 'var ' + Name + ': ' + VarType.Name; - - if IsConstant then - if (VarType.BaseType in LapeCharTypes) then - Str := Str + ' = "' + AsString + '"' - else - Str := Str + ' = ' + AsString; - - Add(DocPos.FileName, Str + ';'); - end; - - Move('type TBox = record X1, Y1, X2, Y2: Integer; end;', 'Base', 'TBox'); - Move('type TBoxArray = array of TBox;', 'Base', 'TBox'); - - Move('type TQuad = record Top, Right, Bottom, Left: TPoint; end;', 'Base', 'TQuad'); - Move('type TQuadArray = array of TQuad;', 'Base', 'TQuad'); - - Move('type TPoint = record X, Y: Integer; end;', 'Base', 'TPoint'); - Move('type TPointArray = array of TPoint;', 'Base', 'TPointArray'); - - Move('type T2DPointArray = array of TPointArray;', 'Base', 'T2DPointArray'); - - Move('type TColor = Int32', 'Base', 'Color Math'); - Move('type TColorArray = array of TColor;', 'Base', 'Color Math'); - - with TStringList.Create() do - try - LineBreak := #0; - for I := 0 to FItems.Count - 1 do - Values[FItems[I].Name] := Values[FItems[I].Name] + FItems[I].Value + LineEnding; - - SaveToFile(FileName); - finally - Free(); - end; -end; - -end. - diff --git a/Source/script/simba.script.pas b/Source/script/simba.script.pas index 48ff64ff0..4cae6cc34 100644 --- a/Source/script/simba.script.pas +++ b/Source/script/simba.script.pas @@ -57,6 +57,7 @@ TSimbaScript = class(TObject) function Compile: Boolean; function Run: Boolean; + procedure Dump(FileName: String); property State: ESimbaScriptState read GetState write SetState; property Script: String read FScript write FScript; @@ -73,7 +74,8 @@ implementation uses simba.env, simba.fs, simba.datetime, simba.target, simba.vartype_windowhandle, simba.vartype_string, - simba.script_pluginloader; + simba.script_pluginloader, + simba.script_imports; function TSimbaScript.DoCompilerPreprocessorFunc(Sender: TLapeCompiler; Name, Argument: lpString; out Value: lpString): Boolean; begin @@ -197,7 +199,10 @@ function TSimbaScript.Compile: Boolean; if (FSimbaCommunication = nil) then FCompiler.addBaseDefine('SIMBAHEADLESS'); - FCompiler.Import(); + FCompiler.Options := FCompiler.Options + [lcoAutoInvoke, lcoExplicitSelf, lcoAutoObjectify, lcoRelativeFileNames] - [lcoInheritableRecords]; + + AddSimbaInternalMethods(Self); + AddSimbaImports(Self); FCompileTime := HighResolutionTime(); FCompiler.Compile(); @@ -213,11 +218,7 @@ function TSimbaScript.Run: Boolean; if (FTargetWindow = 0) or (not FTargetWindow.IsValid()) then FTargetWindow := GetDesktopWindow(); - PString(FCompiler['SCRIPT_FILE'].Ptr)^ := FScriptFileName; - PUInt64(FCompiler['SCRIPT_START_TIME'].Ptr)^ := GetTickCount64(); - PSimbaTarget(FCompiler['Target'].Ptr)^.SetWindow(FTargetWindow); - PPointer(FCompiler['_SimbaScript'].Ptr)^ := Self; FRunningTime := HighResolutionTime(); try @@ -237,6 +238,29 @@ function TSimbaScript.Run: Boolean; Result := True; end; +procedure TSimbaScript.Dump(FileName: String); +var + I: Integer; + Decl: TLapeDeclaration; + Str: String; +begin + FCompiler := TSimbaScript_Compiler.CreateDump(FileName); + + AddSimbaInternalMethods(Self); + AddSimbaImports(Self); + + with TStringList.Create() do + try + LineBreak := #0; + for I := 0 to FCompiler.Dump.Count - 1 do + Values[FCompiler.Dump[I].Name] := Values[FCompiler.Dump[I].Name] + FCompiler.Dump[I].Value + LineEnding; + + SaveToFile(FileName); + finally + Free(); + end; +end; + constructor TSimbaScript.Create; begin inherited Create(); diff --git a/Source/script/simba.script_compiler.pas b/Source/script/simba.script_compiler.pas index e7bb206e9..6801b1178 100644 --- a/Source/script/simba.script_compiler.pas +++ b/Source/script/simba.script_compiler.pas @@ -11,19 +11,23 @@ interface uses Classes, SysUtils, - ffi, lpffi, lpcompiler, lptypes, lpvartypes, lpparser, lptree, lpffiwrappers, lpinterpreter, - simba.base; + lpcompiler, lptypes, lpvartypes, lptree, lpffiwrappers, ffi, + simba.base, simba.containers, simba.vartype_string; type - TManagedImportClosure = class(TLapeDeclaration) - Closure: TImportClosure; - end; - TSimbaScript_Compiler = class(TLapeCompiler) + protected type + TManagedImportClosure = class(TLapeDeclaration) + Closure: TImportClosure; + end; protected - FImportingSection: String; + FDumpSection: String; + FDump: TSimbaStringPairList; - function GetImportingSection: String; + procedure DumpAdd(const Section, Str: String); + procedure DumpMethod(Str: String); + procedure DumpType(Name, Str: String); + procedure DumpVar(Name, Typ: String); procedure InitBaseFile; override; procedure InitBaseVariant; override; @@ -31,205 +35,103 @@ TSimbaScript_Compiler = class(TLapeCompiler) procedure InitBaseMath; override; procedure InitBaseString; override; procedure InitBaseDateTime; override; + + function GetDumpSection: String; public + constructor CreateDump(FileName: String); overload; + destructor Destroy; override; + + // Overrides for dumping + function addGlobalVar(Typ: lpString; Value: Pointer; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Typ: lpString; Value: lpString; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Typ: ELapeBaseType; Value: Pointer; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: Int32; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: UInt32; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: Int64; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: UInt64; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: Single; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: Double; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: AnsiString; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: UnicodeString; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: Variant; AName: lpString): TLapeGlobalVar; override; + function addGlobalVar(Value: Pointer; AName: lpString): TLapeGlobalVar; override; + function addGlobalFunc(Header: lpString; Value: Pointer): TLapeGlobalVar; override; + function addGlobalType(Str: lpString; AName: lpString): TLapeType; override; + + // Compiler addons procedure pushCode(Code: String); - - procedure addDelayedCode(Code: TStringArray; AFileName: lpString = ''); virtual; overload; - - function addGlobalFunc(Header: lpString; Body: TStringArray): TLapeTree_Method; virtual; overload; - function addGlobalFunc(Header: lpString; Value: Pointer; ABI: TFFIABI): TLapeGlobalVar; virtual; overload; - - function addGlobalType(Str: lpString; AName: lpString; ABI: TFFIABI): TLapeType; virtual; overload; - function addGlobalType(Str: TStringArray; Name: String): TLapeType; virtual; overload; - - function addClassConstructor(Obj, Params: lpString; Func: Pointer; IsOverload: Boolean = False): TLapeGlobalVar; virtual; - procedure addClass(Name: lpString; Parent: lpString = 'TObject'); virtual; - + procedure addDelayedCode(Code: TStringArray; AFileName: lpString = ''); overload; + function addGlobalFunc(Header: lpString; Body: TStringArray): TLapeTree_Method;overload; + function addGlobalFunc(Header: lpString; Value: Pointer; ABI: TFFIABI): TLapeGlobalVar; overload; + function addGlobalType(Str: lpString; AName: lpString; ABI: TFFIABI): TLapeType; overload; + function addGlobalType(Str: TStringArray; Name: String): TLapeType; overload; + function addClassConstructor(Obj, Params: lpString; Func: Pointer; IsOverload: Boolean = False): TLapeGlobalVar; + procedure addClass(Name: lpString; Parent: lpString = 'TObject'); procedure addProperty(Obj, Name, Typ: String; ReadFunc: Pointer; WriteFunc: Pointer = nil); procedure addPropertyIndexed(Obj, Name, Params, Typ: String; ReadFunc: Pointer; WriteFunc: Pointer = nil); - procedure addMagic(Name: String; Params: array of lpString; ParamTypes: array of ELapeParameterType; Res: String; Func: Pointer); - - procedure Import; virtual; function Compile: Boolean; override; - procedure CallProc(ProcName: String); - property ImportingSection: String read GetImportingSection write FImportingSection; + + property DumpSection: String read GetDumpSection write FDumpSection; + property Dump: TSimbaStringPairList read FDump; end; implementation uses - lpeval, - simba.vartype_string, - simba.script_imports, - simba.script_compiler_sleepuntil, - simba.script_compiler_rtti, - simba.script_compiler_imagefromstring, - simba.script_genericmap, - simba.script_genericstringmap, - simba.script_genericheap; - -procedure TSimbaScript_Compiler.addProperty(Obj, Name, Typ: String; ReadFunc: Pointer; WriteFunc: Pointer); -begin - if (ReadFunc <> nil) then - addGlobalFunc('property ' + Obj + '.' + Name + ': ' + Typ + ';', ReadFunc); - if (WriteFunc <> nil) then - addGlobalFunc('property ' + Obj + '.' + Name + '(Value: ' + Typ + ');', WriteFunc); -end; - -procedure TSimbaScript_Compiler.addPropertyIndexed(Obj, Name, Params, Typ: String; ReadFunc: Pointer; WriteFunc: Pointer); -begin - if (ReadFunc <> nil) then - addGlobalFunc('property ' + Obj + '.' + Name + '(' + Params + '):' + Typ + ';', ReadFunc); - if (WriteFunc <> nil) then - addGlobalFunc('property ' + Obj + '.' + Name + '(' + Params + '; Value: ' + Typ + ');', WriteFunc); -end; - -procedure TSimbaScript_Compiler.addMagic(Name: String; Params: array of lpString; ParamTypes: array of ELapeParameterType; Res: String; Func: Pointer); - - function getType(Name: lpString): TLapeType; - begin - if (Name <> '') then - begin - Result := getGlobalType(Name); - if (Result = nil) then - begin - Result := getBaseType(Name); - if (Result = nil) then - SimbaException('Type "%s" not found', [Name]); - end; - end else - Result := nil; - end; + lpeval, lpparser, lpinterpreter; +procedure TSimbaScript_Compiler.DumpAdd(const Section, Str: String); var - ParamVarTypes: array of TLapeType; - ParamDefaults: array of TLapeGlobalVar; - i: Integer; - Header: TLapeType_Method; + Item: TSimbaStringPair; begin - if (Globals[Name] = nil) or (not (Globals[Name].VarType is TLapeType_OverloadedMethod)) then - SimbaException('addNativeMagic "%s" is incorrect', [Name]); + Item.Name := Section; + Item.Value := Str; - SetLength(ParamVarTypes, Length(Params)); - SetLength(ParamDefaults, Length(Params)); - for i := 0 to High(ParamVarTypes) do - ParamVarTypes[i] := getType(Params[i]); - - Header := addManagedType(TLapeType_Method.Create(Self, ParamVarTypes, ParamTypes, ParamDefaults, getType(Res))) as TLapeType_Method; - TLapeType_OverloadedMethod(Globals[Name].VarType).addMethod(Header.NewGlobalVar(Func)); -end; - -function TSimbaScript_Compiler.addGlobalFunc(Header: lpString; Body: TStringArray): TLapeTree_Method; -var - OldState: Pointer; -begin - OldState := getTempTokenizerState(LapeDelayedFlags + Header + LineEnding.Join(Body), '!' + Header); - try - Expect([tk_kw_Function, tk_kw_Procedure, tk_kw_Operator, tk_kw_Property]); - Result := ParseMethod(nil, False); - CheckAfterCompile(); - addDelayedExpression(Result, True, True); - finally - resetTokenizerState(OldState); - end; + FDump.Add(Item); end; -function TSimbaScript_Compiler.addGlobalFunc(Header: lpString; Value: Pointer; ABI: TFFIABI): TLapeGlobalVar; -var - Closure: TManagedImportClosure; +procedure TSimbaScript_Compiler.DumpMethod(Str: String); begin - Closure := TManagedImportClosure.Create(); - Closure.Closure := LapeImportWrapper(Value, Self, Header, ABI); + Str := Str.Trim(); + if not Str.EndsWith(';') then + Str := Str + ';'; + Str := Str + ' external;'; - with TManagedImportClosure(addManagedDecl(Closure)) do - Result := addGlobalFunc(Header, Closure.Func); + DumpAdd(DumpSection, Str); end; -function TSimbaScript_Compiler.addGlobalType(Str: lpString; AName: lpString; ABI: TFFIABI): TLapeType; +procedure TSimbaScript_Compiler.DumpType(Name, Str: String); begin - Result := addGlobalType('native(type ' + Str + ', ffi_' + ABIToStr(ABI) + ')', AName); -end; + if Name.StartsWith('!') then + Exit; + Str := 'type ' + Name + ' = ' + Str; + if not Str.EndsWith(';') then + Str := Str + ';'; -function TSimbaScript_Compiler.addGlobalType(Str: TStringArray; Name: String): TLapeType; -begin - Result := addGlobalType(LineEnding.Join(Str), Name); + DumpAdd(DumpSection, Str); end; -function TSimbaScript_Compiler.addClassConstructor(Obj, Params: lpString; Func: Pointer; IsOverload: Boolean): TLapeGlobalVar; +procedure TSimbaScript_Compiler.DumpVar(Name, Typ: String); var - Directives: String; + Str: String; begin - Directives := 'static;'; - if IsOverload then - Directives := Directives + ' overload;'; + if Name.StartsWith('!') then + Exit; + Str := 'var ' + Name + ': ' + Typ; + if not Str.EndsWith(';') then + Str := Str + ';'; - Result := addGlobalFunc('function ' + Obj + '.Create' + Params + ': ' + Obj + ';' + Directives, Func); -end; - -procedure TSimbaScript_Compiler.addClass(Name: lpString; Parent: lpString); -begin - addGlobalType('strict ' + Parent, Name); + DumpAdd(DumpSection, Str); end; -procedure TSimbaScript_Compiler.Import; -begin - StartImporting(); - - try - Options := Options + [lcoAutoInvoke, lcoExplicitSelf, lcoAutoObjectify, lcoRelativeFileNames] - [lcoInheritableRecords]; - - InitializeImageFromString(Self); - InitializeSleepUntil(Self); - InitializeFFI(Self); - InitializeRTTI(Self); - InitializeMap(Self); - InitializeStringMap(Self); - InitializeHeap(Self); - - AddSimbaImports(Self); - finally - EndImporting(); - end; -end; - -function TSimbaScript_Compiler.Compile: Boolean; +function TSimbaScript_Compiler.GetDumpSection: String; begin - {$IF DEFINED(DARWIN) and DECLARED(LoadFFI)} - if not FFILoaded then - LoadFFI('/usr/local/opt/libffi/lib/'); - {$ENDIF} + if (FDumpSection = '') then + FDumpSection := '!Simba'; - if not FFILoaded then - raise Exception.Create('ERROR: libffi is missing or incompatible'); - - Result := inherited Compile(); -end; - -procedure TSimbaScript_Compiler.CallProc(ProcName: String); -var - Method: TLapeGlobalVar; -begin - Method := Globals[ProcName]; - if (Method = nil) or (Method.BaseType <> ltScriptMethod) or - (TLapeType_Method(Method.VarType).Res <> nil) or (TLapeType_Method(Method.VarType).Params.Count <> 0) then - SimbaException('CallProc: Invalid procedure "%s"', [ProcName]); - - with TLapeCodeRunner.Create(Emitter) do - try - Run(PCodePos(Method.Ptr)^); - finally - Free(); - end; -end; - -function TSimbaScript_Compiler.GetImportingSection: String; -begin - if (FImportingSection = '') then - FImportingSection := '!Simba'; - - Result := FImportingSection; + Result := FDumpSection; end; procedure TSimbaScript_Compiler.InitBaseFile; @@ -244,17 +146,17 @@ procedure TSimbaScript_Compiler.InitBaseVariant; procedure TSimbaScript_Compiler.InitBaseDefinitions; begin - ImportingSection := 'Base'; + DumpSection := 'Base'; inherited InitBaseDefinitions(); - ImportingSection := ''; + DumpSection := ''; end; // lpeval_import_math.inc but moved Random functions under Random section procedure TSimbaScript_Compiler.InitBaseMath; begin - ImportingSection := 'Math'; + DumpSection := 'Math'; addGlobalVar(Pi, 'Pi').isConstant := True; @@ -305,7 +207,7 @@ procedure TSimbaScript_Compiler.InitBaseMath; addGlobalFunc('procedure SinCos(theta: Double; out sinus, cosinus: Double);', @_LapeSinCos); addGlobalFunc('procedure DivMod(Dividend: UInt32; Divisor: UInt16; var Result, Remainder: UInt16);', @_LapeDivMod); - ImportingSection := 'Random'; + DumpSection := 'Random'; addGlobalVar(ltUInt32, @RandSeed, 'RandSeed'); @@ -315,13 +217,13 @@ procedure TSimbaScript_Compiler.InitBaseMath; addGlobalFunc('function Random: Double; overload;', @_LapeRandomF); addGlobalFunc('procedure Randomize;', @_LapeRandomize); - ImportingSection := ''; + DumpSection := ''; end; // lpeval_import_string.inc but removed a few things procedure TSimbaScript_Compiler.InitBaseString; begin - ImportingSection := 'Base'; + DumpSection := 'Base'; addGlobalType('set of (rfReplaceAll, rfIgnoreCase)', 'TReplaceFlags'); @@ -399,13 +301,13 @@ procedure TSimbaScript_Compiler.InitBaseString; addGlobalFunc('function StringOfChar(c: Char; l: SizeInt): string;', @_LapeStringOfChar); - ImportingSection := ''; + DumpSection := ''; end; // Import our own methods later (import_datetime.pas) procedure TSimbaScript_Compiler.InitBaseDateTime; begin - ImportingSection := 'Date & Time'; + DumpSection := 'Date & Time'; addGlobalType(getBaseType(ltDouble).createCopy(True), 'TDateTime', False); @@ -424,7 +326,142 @@ procedure TSimbaScript_Compiler.InitBaseDateTime; addGlobalFunc('function GetTickCount: UInt64;', @_LapeGetTickCount); addGlobalFunc('procedure Sleep(MilliSeconds: UInt32);', @_LapeSleep); - ImportingSection := ''; + DumpSection := ''; +end; + +constructor TSimbaScript_Compiler.CreateDump(FileName: String); +begin + FDump := TSimbaStringPairList.Create(); + + Create(TLapeTokenizerString.Create('begin end;')); +end; + +destructor TSimbaScript_Compiler.Destroy; +begin + if (FDump <> nil) then + FreeAndNil(FDump); + + inherited Destroy; +end; + +function TSimbaScript_Compiler.addGlobalVar(Typ: lpString; Value: Pointer; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, Typ); +end; + +function TSimbaScript_Compiler.addGlobalVar(Typ: lpString; Value: lpString; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, Typ); +end; + +function TSimbaScript_Compiler.addGlobalVar(Typ: ELapeBaseType; Value: Pointer; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, LapeTypeToString(Typ)); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: Int32; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'Int32'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: UInt32; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'UInt32'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: Int64; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'Int64'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: UInt64; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'UInt64'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: Single; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'Single'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: Double; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'Double'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: AnsiString; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'String'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: UnicodeString; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'UnicodeString'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: Variant; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'Variant'); +end; + +function TSimbaScript_Compiler.addGlobalVar(Value: Pointer; AName: lpString): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpVar(AName, 'Pointer'); +end; + +function TSimbaScript_Compiler.addGlobalFunc(Header: lpString; Value: Pointer): TLapeGlobalVar; +begin + Result := inherited; + + if (FDump <> nil) then + DumpMethod(Header); +end; + +function TSimbaScript_Compiler.addGlobalType(Str: lpString; AName: lpString): TLapeType; +begin + Result := inherited; + + if (FDump <> nil) then + DumpType(AName, Str); end; procedure TSimbaScript_Compiler.pushCode(Code: String); @@ -437,5 +474,144 @@ procedure TSimbaScript_Compiler.addDelayedCode(Code: TStringArray; AFileName: lp addDelayedCode(LapeDelayedFlags + LineEnding.Join(Code), AFileName); end; +procedure TSimbaScript_Compiler.addProperty(Obj, Name, Typ: String; ReadFunc: Pointer; WriteFunc: Pointer); +begin + if (ReadFunc <> nil) then + addGlobalFunc('property ' + Obj + '.' + Name + ': ' + Typ + ';', ReadFunc); + if (WriteFunc <> nil) then + addGlobalFunc('property ' + Obj + '.' + Name + '(Value: ' + Typ + ');', WriteFunc); +end; + +procedure TSimbaScript_Compiler.addPropertyIndexed(Obj, Name, Params, Typ: String; ReadFunc: Pointer; WriteFunc: Pointer); +begin + if (ReadFunc <> nil) then + addGlobalFunc('property ' + Obj + '.' + Name + '(' + Params + '):' + Typ + ';', ReadFunc); + if (WriteFunc <> nil) then + addGlobalFunc('property ' + Obj + '.' + Name + '(' + Params + '; Value: ' + Typ + ');', WriteFunc); +end; + +procedure TSimbaScript_Compiler.addMagic(Name: String; Params: array of lpString; ParamTypes: array of ELapeParameterType; Res: String; Func: Pointer); + + function getType(Name: lpString): TLapeType; + begin + if (Name <> '') then + begin + Result := getGlobalType(Name); + if (Result = nil) then + begin + Result := getBaseType(Name); + if (Result = nil) then + SimbaException('Type "%s" not found', [Name]); + end; + end else + Result := nil; + end; + +var + ParamVarTypes: array of TLapeType; + ParamDefaults: array of TLapeGlobalVar; + i: Integer; + Header: TLapeType_Method; +begin + if (Globals[Name] = nil) or (not (Globals[Name].VarType is TLapeType_OverloadedMethod)) then + SimbaException('addNativeMagic "%s" is incorrect', [Name]); + + SetLength(ParamVarTypes, Length(Params)); + SetLength(ParamDefaults, Length(Params)); + for i := 0 to High(ParamVarTypes) do + ParamVarTypes[i] := getType(Params[i]); + + Header := addManagedType(TLapeType_Method.Create(Self, ParamVarTypes, ParamTypes, ParamDefaults, getType(Res))) as TLapeType_Method; + with TLapeType_OverloadedMethod(Globals[Name].VarType) do + addMethod(Header.NewGlobalVar(Func)); +end; + +function TSimbaScript_Compiler.addGlobalFunc(Header: lpString; Body: TStringArray): TLapeTree_Method; +var + Decl: lpString; + OldState: Pointer; +begin + Decl := Header + LineEnding + LineEnding.Join(Body); + OldState := getTempTokenizerState(LapeDelayedFlags + Decl, '!' + Header); + try + Expect([tk_kw_Function, tk_kw_Procedure, tk_kw_Operator, tk_kw_Property]); + Result := ParseMethod(nil, False); + CheckAfterCompile(); + addDelayedExpression(Result, True, True); + finally + resetTokenizerState(OldState); + end; + + if (FDump <> nil) then + DumpAdd(DumpSection, Decl); +end; + +function TSimbaScript_Compiler.addGlobalFunc(Header: lpString; Value: Pointer; ABI: TFFIABI): TLapeGlobalVar; +var + Closure: TManagedImportClosure; +begin + Closure := TManagedImportClosure.Create(); + Closure.Closure := LapeImportWrapper(Value, Self, Header, ABI); + + with TManagedImportClosure(addManagedDecl(Closure)) do + Result := addGlobalFunc(Header, Closure.Func); +end; + +function TSimbaScript_Compiler.addGlobalType(Str: lpString; AName: lpString; ABI: TFFIABI): TLapeType; +begin + Result := addGlobalType('native(type ' + Str + ', ffi_' + ABIToStr(ABI) + ')', AName); +end; + +function TSimbaScript_Compiler.addGlobalType(Str: TStringArray; Name: String): TLapeType; +begin + Result := addGlobalType(LineEnding.Join(Str), Name); +end; + +function TSimbaScript_Compiler.addClassConstructor(Obj, Params: lpString; Func: Pointer; IsOverload: Boolean): TLapeGlobalVar; +var + Directives: String; +begin + Directives := 'static;'; + if IsOverload then + Directives := Directives + ' overload;'; + + Result := addGlobalFunc('function ' + Obj + '.Create' + Params + ': ' + Obj + ';' + Directives, Func); +end; + +procedure TSimbaScript_Compiler.addClass(Name: lpString; Parent: lpString); +begin + addGlobalType('strict ' + Parent, Name); +end; + +function TSimbaScript_Compiler.Compile: Boolean; +begin + {$IF DEFINED(DARWIN) and DECLARED(LoadFFI)} + if not FFILoaded then + LoadFFI('/usr/local/opt/libffi/lib/'); + {$ENDIF} + + if not FFILoaded then + raise Exception.Create('ERROR: libffi is missing or incompatible'); + + Result := inherited Compile(); +end; + +procedure TSimbaScript_Compiler.CallProc(ProcName: String); +var + Method: TLapeGlobalVar; +begin + Method := Globals[ProcName]; + if (Method = nil) or (Method.BaseType <> ltScriptMethod) or + (TLapeType_Method(Method.VarType).Res <> nil) or (TLapeType_Method(Method.VarType).Params.Count <> 0) then + SimbaException('CallProc: Invalid procedure "%s"', [ProcName]); + + with TLapeCodeRunner.Create(Emitter) do + try + Run(PCodePos(Method.Ptr)^); + finally + Free(); + end; +end; + end. diff --git a/Source/script/simba.script_imports.pas b/Source/script/simba.script_imports.pas index a22ac7d09..67afbffbd 100644 --- a/Source/script/simba.script_imports.pas +++ b/Source/script/simba.script_imports.pas @@ -10,18 +10,28 @@ interface uses - simba.script_compiler; + simba.script; -procedure AddSimbaImports(Compiler: TSimbaScript_Compiler); +procedure AddSimbaInternalMethods(Script: TSimbaScript); +procedure AddSimbaImports(Script: TSimbaScript); implementation uses + lpffi, + // Lape Internal methods + simba.script_compiler_sleepuntil, + simba.script_compiler_rtti, + simba.script_compiler_imagefromstring, + simba.script_genericmap, + simba.script_genericstringmap, + simba.script_genericheap, + // Simba simba.import_base, simba.import_colormath,simba.import_matrix, simba.import_windowhandle, simba.import_quad, simba.import_box, simba.import_boxarray, simba.import_point, simba.import_circle, simba.import_datetime, simba.import_tpa, simba.import_atpa, - simba.import_encoding, simba.import_file, simba.import_process, simba.import_internal, + simba.import_encoding, simba.import_file, simba.import_process, simba.import_target, simba.import_math, simba.import_misc, simba.import_slacktree, simba.import_string, simba.import_random, simba.import_debugimage, simba.import_web, simba.import_threading, simba.import_pointbuffer, simba.import_async, @@ -35,54 +45,64 @@ implementation simba.import_lcl_form, simba.import_lcl_stdctrls, simba.import_lcl_extctrls, simba.import_lcl_comctrls, simba.import_lcl_misc; -procedure AddSimbaImports(Compiler: TSimbaScript_Compiler); +procedure AddSimbaInternalMethods(Script: TSimbaScript); +begin + InitializeImageFromString(Script.Compiler); + InitializeSleepUntil(Script.Compiler); + InitializeFFI(Script.Compiler); + InitializeRTTI(Script.Compiler); + InitializeMap(Script.Compiler); + InitializeStringMap(Script.Compiler); + InitializeHeap(Script.Compiler); +end; + +procedure AddSimbaImports(Script: TSimbaScript); begin - ImportBase(Compiler); - ImportColorMath(Compiler); - ImportMatrix(Compiler); - ImportWindowHandle(Compiler); - ImportQuad(Compiler); - ImportCircle(Compiler); - ImportBox(Compiler); - ImportBoxArray(Compiler); - ImportPoint(Compiler); - - ImportLCLSystem(Compiler); - ImportLCLGraphics(Compiler); - ImportLCLControls(Compiler); - ImportLCLForm(Compiler); - ImportLCLStdCtrls(Compiler); - ImportLCLExtCtrls(Compiler); - ImportLCLComCtrls(Compiler); - ImportLCLMisc(Compiler); - - ImportDTM(Compiler); - ImportSimbaImage(Compiler); - ImportExternalCanvas(Compiler); - ImportMatchTemplate(Compiler); - ImportJSON(Compiler); - - ImportDateTime(Compiler); - ImportTPA(Compiler); - ImportATPA(Compiler); - ImportEncoding(Compiler); - ImportFile(Compiler); - ImportProcess(Compiler); - ImportInternal(Compiler); - ImportTarget(Compiler); - ImportMath(Compiler); - ImportSlackTree(Compiler); - ImportString(Compiler); - ImportRandom(Compiler); - ImportDebugImage(Compiler); - ImportWeb(Compiler); - ImportMisc(Compiler); - ImportThreading(Compiler); - ImportASync(Compiler); - ImportPointBuffer(Compiler); - - ImportSimbaImageBox(Compiler); - ImportSimbaShapeBox(Compiler); + ImportBase(Script); + ImportColorMath(Script); + ImportMatrix(Script); + ImportWindowHandle(Script); + ImportQuad(Script); + ImportCircle(Script); + ImportBox(Script); + ImportBoxArray(Script); + ImportPoint(Script); + + ImportLCLSystem(Script); + ImportLCLGraphics(Script); + ImportLCLControls(Script); + ImportLCLForm(Script); + ImportLCLStdCtrls(Script); + ImportLCLExtCtrls(Script); + ImportLCLComCtrls(Script); + ImportLCLMisc(Script); + + ImportDTM(Script); + ImportSimbaImage(Script); + ImportExternalCanvas(Script); + ImportMatchTemplate(Script); + ImportJSON(Script); + + ImportDateTime(Script); + ImportTPA(Script); + ImportATPA(Script); + ImportEncoding(Script); + ImportFile(Script); + ImportProcess(Script); + ImportTarget(Script); + ImportMath(Script); + ImportSlackTree(Script); + ImportString(Script); + ImportRandom(Script); + ImportDebugImage(Script); + ImportWeb(Script); + ImportMisc(Script); + ImportThreading(Script); + ImportASync(Script); + ImportPointBuffer(Script); + + ImportSimbaImageBox(Script); + ImportSimbaShapeBox(Script); end; end. diff --git a/Third-Party/lape b/Third-Party/lape index 522dcefef..0a0cf1258 160000 --- a/Third-Party/lape +++ b/Third-Party/lape @@ -1 +1 @@ -Subproject commit 522dcefef83f8d48f73d8546adcd19d97ab0bb45 +Subproject commit 0a0cf125803d207f03e3d35c21979055b9066ff3