diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..4ab43a4 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "Units/lape"] + path = Units/lape + url = git://villavu.com/lape.git diff --git a/Projects/Simba/Simba.inc b/Projects/Simba/Simba.inc index b0079f7..842ac89 100644 --- a/Projects/Simba/Simba.inc +++ b/Projects/Simba/Simba.inc @@ -27,9 +27,9 @@ {$ENDIF} //{$DEFINE USE_RUTIS} +//{$DEFINE USE_LAPE} //{$DEFINE USE_CPASCAL} // TODO -//{$DEFINE USE_LAPE} // TODO //{$DEFINE USE_EXTENSIONS} // TODO //{$DEFINE USE_CODECOMPLETION} // TODO diff --git a/Projects/Simba/Simba.lpi b/Projects/Simba/Simba.lpi index 44c4dc8..a2d0f81 100644 --- a/Projects/Simba/Simba.lpi +++ b/Projects/Simba/Simba.lpi @@ -316,8 +316,8 @@ - - + + diff --git a/Projects/Simba/simbaunit.lfm b/Projects/Simba/simbaunit.lfm index 95f42de..a367b01 100644 --- a/Projects/Simba/simbaunit.lfm +++ b/Projects/Simba/simbaunit.lfm @@ -5,7 +5,7 @@ object SimbaForm: TSimbaForm Width = 660 AllowDropFiles = True Caption = 'THA FUKING Simba' - ClientHeight = 598 + ClientHeight = 603 ClientWidth = 660 KeyPreview = True Menu = MainMenu @@ -207,8 +207,8 @@ object SimbaForm: TSimbaForm end object StatusBar: TStatusBar Left = 0 - Height = 21 - Top = 577 + Height = 23 + Top = 580 Width = 660 Panels = < item @@ -230,7 +230,7 @@ object SimbaForm: TSimbaForm object PanelMemo: TPanel Left = 0 Height = 154 - Top = 423 + Top = 426 Width = 660 Align = alBottom ClientHeight = 154 @@ -253,19 +253,19 @@ object SimbaForm: TSimbaForm Cursor = crVSplit Left = 0 Height = 5 - Top = 418 + Top = 421 Width = 660 Align = alBottom ResizeAnchor = akBottom end object ScriptPanel: TPanel Left = 0 - Height = 394 + Height = 397 Top = 24 Width = 660 Align = alClient BevelOuter = bvNone - ClientHeight = 394 + ClientHeight = 397 ClientWidth = 660 DockSite = True TabOrder = 4 @@ -273,7 +273,7 @@ object SimbaForm: TSimbaForm OnDockOver = ScriptPanelDockOver object PageControl1: TPageControl Left = 155 - Height = 359 + Height = 362 Top = 0 Width = 505 Align = alClient @@ -292,7 +292,7 @@ object SimbaForm: TSimbaForm object SearchPanel: TPanel Left = 0 Height = 35 - Top = 359 + Top = 362 Width = 660 Align = alBottom BevelOuter = bvSpace @@ -387,7 +387,7 @@ object SimbaForm: TSimbaForm end object LabeledEditSearch: TLabeledEdit Left = 104 - Height = 27 + Height = 23 Top = 6 Width = 80 EditLabel.AnchorSideLeft.Control = LabeledEditSearch @@ -395,10 +395,10 @@ object SimbaForm: TSimbaForm EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch - EditLabel.Left = 66 - EditLabel.Height = 18 - EditLabel.Top = 10 - EditLabel.Width = 35 + EditLabel.Left = 71 + EditLabel.Height = 16 + EditLabel.Top = 9 + EditLabel.Width = 30 EditLabel.Caption = 'Find: ' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -413,7 +413,7 @@ object SimbaForm: TSimbaForm Left = 320 Height = 19 Top = 7 - Width = 93 + Width = 80 Caption = 'Match case' OnClick = CheckBoxMatchCaseClick TabOrder = 1 @@ -421,38 +421,38 @@ object SimbaForm: TSimbaForm end object SplitterFunctionList: TSplitter Left = 150 - Height = 359 + Height = 362 Top = 0 Width = 5 OnCanResize = SplitterFunctionListCanResize Visible = False end inline frmFunctionList: TFunctionListFrame - Height = 359 + Height = 362 Width = 150 - ClientHeight = 359 + ClientHeight = 362 ClientWidth = 150 OnEndDock = nil TabOrder = 3 inherited FunctionList: TTreeView - Height = 310 - Top = 22 + Height = 319 + Top = 20 Width = 150 - DefaultItemHeight = 19 + DefaultItemHeight = 17 OnChange = FunctionListChange OnEnter = FunctionListEnter OnExit = FunctionListExit end inherited editSearchList: TEdit - Height = 27 - Top = 332 + Height = 23 + Top = 339 Width = 150 OnExit = editSearchListExit OnKeyDown = editSearchListKeyDown OnKeyPress = editSearchListKeyPress end inherited FunctionListLabel: TLabel - Height = 18 + Height = 16 Width = 146 end end @@ -1263,12 +1263,18 @@ object SimbaForm: TSimbaForm end object MenuItemRUTIS: TMenuItem Action = ActionRUTIS + Enabled = False RadioItem = True end object MenuItemCPascal: TMenuItem Action = ActionCPascal RadioItem = True end + object MenuItemLape: TMenuItem + Action = ActionLape + Enabled = False + RadioItem = True + end end end object MenuView: TMenuItem @@ -3025,6 +3031,10 @@ object SimbaForm: TSimbaForm OnExecute = ActionGotoExecute ShortCut = 16455 end + object ActionLape: TAction + Caption = 'Lape' + OnExecute = ActionLapeExecute + end end object DebugTimer: TTimer OnTimer = ProcessDebugStream diff --git a/Projects/Simba/simbaunit.pas b/Projects/Simba/simbaunit.pas index 904d787..37bacb6 100644 --- a/Projects/Simba/simbaunit.pas +++ b/Projects/Simba/simbaunit.pas @@ -66,6 +66,7 @@ const interp_PS = 0; //PascalScript interp_RT = 1; //RUTIS interp_CP = 2; //CPascal + interp_LP = 3; //Lape { Place the shortcuts here } {$IFDEF LINUX} @@ -100,6 +101,7 @@ type { TSimbaForm } TSimbaForm = class(TForm) + ActionLape: TAction; ActionGoto: TAction; ActionCPascal: TAction; ActionRUTIS: TAction; @@ -145,6 +147,7 @@ type MenuHelp: TMenuItem; MenuDivider7: TMenuItem; MenuInterpreters: TMenuItem; + MenuItemLape: TMenuItem; MenuItemReadOnlyTab: TMenuItem; MenuItemGoto: TMenuItem; MenuItemDivider50: TMenuItem; @@ -285,6 +288,7 @@ type procedure ActionFindNextExecute(Sender: TObject); procedure ActionFindstartExecute(Sender: TObject); procedure ActionGotoExecute(Sender: TObject); + procedure ActionLapeExecute(Sender: TObject); procedure ActionNewExecute(Sender: TObject); procedure ActionNewTabExecute(Sender: TObject); procedure ActionNormalSizeExecute(Sender: TObject); @@ -733,13 +737,15 @@ end; procedure TSimbaForm.UpdateInterpreter; begin - ActionPascalScript.Checked:= false; - ActionRUTIS.Checked:= false; - ActionCPascal.Checked:= false; + ActionPascalScript.Checked := False; + ActionRUTIS.Checked := False; + ActionCPascal.Checked := False; + ActionLape.Checked := False; case Interpreter of interp_PS: ActionPascalScript.Checked:= True; interp_CP: ActionCPascal.Checked:= True; - interp_RT: ActionRUTIS.Checked:= true; + interp_RT: ActionRUTIS.Checked := True; + interp_LP: ActionLape.Checked := True; end; end; @@ -762,11 +768,11 @@ end; function TSimbaForm.GetInterpreter: Integer; begin - result := StrToIntDef(LoadSettingDef('Settings/Interpreter/Type','0'),0); - if (result < 0) or (result > 2) then + Result := StrToIntDef(LoadSettingDef('Settings/Interpreter/Type', '0'), 0); + if ((Result < 0) or (Result > 3)) then begin SetInterpreter(0); - result := 0; + Result := 0; end; end; @@ -972,7 +978,7 @@ var time:integer; LatestVersion : integer; begin - UpdateTimer.Interval:= MaxInt; + UpdateTimer.Interval := MaxInt; FontUpdate; chk := LowerCase(LoadSettingDef('Settings/Updater/CheckForUpdates','True')); @@ -991,7 +997,7 @@ begin mDebugLn('Latest Simba Version: ' + IntToStr(LatestVersion)); end; time := StrToIntDef(LoadSettingDef('Settings/Updater/CheckEveryXMinutes','30'),30); - UpdateTimer.Interval:= time {mins} * 60 {secs} * 1000 {ms};//Every half hour + UpdateTimer.Interval := time {mins} * 60 {secs} * 1000 {ms};//Every half hour end; procedure TSimbaForm.UpdateMenuButtonClick(Sender: TObject); @@ -1396,7 +1402,7 @@ begin SettingsForm.SettingsTreeView.Items.GetFirstNode.Expand(false); SettingsForm.SaveCurrent; LoadFormSettings; - UpdateTimer.Interval:=25; + UpdateTimer.Interval :=25; end; { Load settings } @@ -1608,19 +1614,21 @@ begin AppPath:= MainDir + DS; CurrScript.ScriptErrorLine:= -1; CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; + try case Interpreter of - interp_PS : Thread := TPSThread.Create(true,@CurrentSyncInfo,PluginPath); - - // XXX: Rutis needs to be completely removed from Simba if it's not defined. - // XXX: Not just print a message that it's not supported now. - interp_RT : {$IFDEF USE_RUTIS}Thread := TRTThread.Create(true,@CurrentSyncInfo,PluginPath){$ELSE}formWriteln('RUTIS NOT SUPPORTED') {$ENDIF}; - interp_CP : Thread := TCPThread.Create(true,@CurrentSyncInfo,PluginPath); + interp_PS: Thread := TPSThread.Create(True, @CurrentSyncInfo, PluginPath); + {$IFDEF USE_RUTIS}interp_RT: Thread := TRTThread.Create(True, @CurrentSyncInfo, PluginPath);{$ENDIF} + interp_CP: Thread := TCPThread.Create(True,@CurrentSyncInfo,PluginPath); + {$IFDEF USE_LAPE}interp_LP: Thread := TLPThread.Create(True, @CurrentSyncInfo, PluginPath);{$ENDIF} + else + raise Exception.CreateFmt('Unknown Interpreter %d!', [Interpreter]); end; except mDebugLn('Failed to initialise the interpreter'); Exit; end; + {$IFNDEF TERMINALWRITELN} Thread.SetDebug(@formWriteln); {$ENDIF} @@ -1729,26 +1737,29 @@ begin end; function TSimbaForm.DefaultScript: string; -var - x : TStringList; begin - result := ''; + Result := ''; + case Interpreter of - interp_PS : begin + interp_PS, interp_LP: begin + Result := 'program new;' + LineEnding + 'begin' + LineEnding + 'end.' + LineEnding; if FileExistsUTF8(SimbaForm.DefScriptPath) then begin - x := TStringList.Create; try - x.LoadFromFile(SimbaForm.DefScriptPath); + with TStringList.Create do + try + LoadFromFile(SimbaForm.DefScriptPath); + Result := Text; + finally + Free; + end; except mDebugLn('Couldn''t load default script file.'); end; - Result := x.Text; - end else - result := 'program new;'+LineEnding + 'begin'+LineEnding+'end.' + LineEnding; + end; end; - interp_RT : result := 'program untitled;' + LineEnding + lineEnding + 'interface' + LineEnding + LineEnding + - 'implementation' + LineEnding + LineEnding + 'begin' + LineEnding + 'end.' + LineEnding; + interp_RT: Result := 'program untitled;' + LineEnding + lineEnding + 'interface' + LineEnding + LineEnding + + 'implementation' + LineEnding + LineEnding + 'begin' + LineEnding + 'end.' + LineEnding; end; end; @@ -1804,7 +1815,7 @@ end; procedure TSimbaForm.ActionCPascalExecute(Sender: TObject); begin - Interpreter:= interp_CP; + Interpreter := interp_CP; end; procedure TSimbaForm.ActionCutExecute(Sender: TObject); @@ -1876,6 +1887,11 @@ begin end; end; +procedure TSimbaForm.ActionLapeExecute(Sender: TObject); +begin + {$IFDEF USE_LAPE}Interpreter := interp_LP;{$ENDIF} +end; + procedure TSimbaForm.ActionClearDebugExecute(Sender: TObject); begin Memo1.Clear; @@ -1917,7 +1933,7 @@ end; procedure TSimbaForm.ActionPascalScriptExecute(Sender: TObject); begin - Interpreter:= interp_PS; + Interpreter := interp_PS; end; procedure TSimbaForm.ActionPasteExecute(Sender: TObject); @@ -2468,9 +2484,8 @@ begin UpdateTitle; - {$IFNDEF USE_RUTIS} - MenuItemRUTIS.Enabled:=False; - {$ENDIF} + {$IFDEF USE_RUTIS}MenuItemRUTIS.Enabled := True;{$ENDIF} + {$IFDEF USE_LAPE}MenuItemLape.Enabled := True;{$ENDIF} self.EndFormUpdate; if SettingsForm.Oops then @@ -3005,9 +3020,11 @@ begin if (CurrScript <> nil) then with CurrScript.Synedit do if (Lines.text = DefaultScript) and not(CanUndo or CanRedo) then - UpdateCurrScript := true; - SetSetting('Settings/Interpreter/Type',Inttostr(AValue),true); + UpdateCurrScript := True; + + SetSetting('Settings/Interpreter/Type', IntToStr(AValue), True); UpdateInterpreter; + if UpdateCurrScript then CurrScript.SynEdit.Lines.text := DefaultScript; end; diff --git a/Units/MMLAddon/LPInc/Wrappers/GENERATE THESE! b/Units/MMLAddon/LPInc/Wrappers/GENERATE THESE! new file mode 100644 index 0000000..e69de29 diff --git a/Units/MMLAddon/LPInc/lpcompile.inc b/Units/MMLAddon/LPInc/lpcompile.inc new file mode 100644 index 0000000..f714567 --- /dev/null +++ b/Units/MMLAddon/LPInc/lpcompile.inc @@ -0,0 +1,89 @@ +{ + This file is part of the Mufasa Macro Library (MML) + Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer + + MML is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + MML is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with MML. If not, see . + + See the file COPYING, included in this distribution, + for details about the copyright. + + lpcompile.inc for the Mufasa Macro Library +} + +addGlobalVar(AppPath, 'AppPath'); +addGlobalVar(ScriptPath, 'ScriptPath'); +addGlobalVar(IncludePath, 'IncludePath'); +addGlobalVar(PluginPath, 'PluginPath'); +addGlobalVar(FontPath, 'FontPath'); +addGlobalVar(maxLongint, 'MaxLongInt'); +addGlobalVar(maxLongint, 'MaxInt'); + +addGlobalVar(ps_mouse_right, 'mouse_Right');//0 +addGlobalVar(ps_mouse_left, 'mouse_Left');//1 +addGlobalVar(ps_mouse_middle, 'mouse_Middle');//2 + +addGlobalType('UInt8', 'Byte'); +addGlobalType('Int8', 'ShortInt'); +addGlobalType('UInt16', 'Word'); +addGlobalType('Int16', 'SmallInt'); +addGlobalType('UInt32', 'LongWord'); +addGlobalType('Int32', 'LongInt'); +addGlobalType('UInt64', 'QWord'); +addGlobalType('LongInt', 'Integer'); + +addGlobalType('Integer', 'TColor'); +addGlobalType('Double', 'TDateTime'); + +addGlobalType('(rfReplaceAll, rfIgnoreCase)', 'TReplaceFlag'); +addGlobalType('set of TReplaceFlag', 'TReplaceFlags'); + +addGlobalType('(Numbers, Letters, Others)', 'StrExtr'); +addGlobalType('(MirrorWidth, MirrorHeight, MirrorLine)', 'TBmpMirrorStyle'); +addGlobalType('(mouse_Down, mouse_Up)', 'TMousePress'); +addGlobalType('(SP_WriteTimeStamp, SP_OnTerminate)', 'TSP_Property'); + +addGlobalType('array of string', 'TStringArray'); +addGlobalType('array of Integer', 'TIntegerArray'); +addGlobalType('array of TIntegerArray', 'T2DIntegerArray'); +addGlobalType('array of T2DIntegerArray', 'T3DIntegerArray'); +addGlobalType('array of byte', 'TByteArray'); +addGlobalType('array of extended', 'TExtendedArray'); +addGlobalType('array of TExtendedArray', 'T2DExtendedArray'); +addGlobalType('array of T2DExtendedArray', 'T3DExtendedArray'); +addGlobalType('array of boolean', 'TBoolArray'); +addGlobalType('array of variant', 'TVariantArray'); + +addGlobalType('record X1, Y1, X2, Y2: integer; end', 'TBox'); +addGlobalType('array of TBox', 'TBoxArray'); + +addGlobalType('record X, Y: integer; end', 'TPoint'); +addGlobalType('array of TPoint', 'TPointArray'); +addGlobalType('array of TPointArray', 'T2DPointArray'); +addGlobalType('T2DPointArray', 'TPointArrayArray'); + +addGlobalType('record White, Black: TPointarray; WhiteHi, BlackHi: integer; W, H: integer; end', 'TMask'); + +addGlobalType('record R, T: extended; end', 'PPoint'); + +addGlobalType('record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15,int16: integer; end', 'TTarget_Exported'); + +addGlobalType('record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end', 'TSDTMPointDef'); +addGlobalType('array of TSDTMPointDef', 'TSDTMPointDefArray'); +addGlobalType('record MainPoint: TSDTMPointDef; SubPoints: TSDTMPointDefarray; end', 'TSDTM'); + +addGlobalType('record x, y, c, t, asz: integer; bp: boolean; end', 'TMDTMPoint'); +addGlobalType('array of TMDTMPoint', 'TMDTMPointArray'); + +addGlobalType('record Title: string; Handle: integer; Pid: integer; Width, Height: integer; end', 'TSysProc'); +addGlobalType('array of TSysProc', 'TSysProcArr'); \ No newline at end of file diff --git a/Units/MMLAddon/LPInc/lpdefines.inc b/Units/MMLAddon/LPInc/lpdefines.inc new file mode 100644 index 0000000..67b5f24 --- /dev/null +++ b/Units/MMLAddon/LPInc/lpdefines.inc @@ -0,0 +1,39 @@ +{ + This file is part of the Mufasa Macro Library (MML) + Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer + + MML is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + MML is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with MML. If not, see . + + See the file COPYING, included in this distribution, + for details about the copyright. + + lpdefines.inc for the Mufasa Macro Library +} + +BaseDefines.Add('LAPE'); +{$IFDEF CPU386 } +BaseDefines.Add('CPU386'); +{$ENDIF } +BaseDefines.Add('MUFASA'); +BaseDefines.Add('COGAT'); +BaseDefines.Add('SIMBA'); +BaseDefines.Add('DGROCKS'); +{$IFDEF MSWINDOWS } +BaseDefines.Add('MSWINDOWS'); +BaseDefines.Add('WIN32'); +BaseDefines.Add('WINDOWS'); +{$ENDIF } +{$IFDEF LINUX } +BaseDefines.Add('LINUX'); +{$ENDIF } \ No newline at end of file diff --git a/Units/MMLAddon/LPInc/lpexportedmethods.inc b/Units/MMLAddon/LPInc/lpexportedmethods.inc new file mode 100644 index 0000000..e6eeb8d --- /dev/null +++ b/Units/MMLAddon/LPInc/lpexportedmethods.inc @@ -0,0 +1,24 @@ +{ + This file is part of the Mufasa Macro Library (MML) + Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer + + MML is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + MML is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with MML. If not, see . + + See the file COPYING, included in this distribution, + for details about the copyright. + + lpexportedmethods.inc for the Mufasa Macro Library +} + +//These will be added from Generator... \ No newline at end of file diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 0079dbd..d7724dd 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -23,8 +23,9 @@ unit mmlpsthread; -{$Define PS_USESSUPPORT} +{$define PS_USESSUPPORT} //{$define USE_RUTIS} +//{$define USE_LAPE} {$mode objfpc}{$H+} interface @@ -35,9 +36,12 @@ uses bitmaps, plugins, dynlibs,internets,scriptproperties, settings,settingssandbox, lcltype, dialogs {$IFDEF USE_RUTIS} - ,Rutis_Engine,Rutis_Defs + , Rutis_Engine, Rutis_Defs {$ENDIF} - ; + {$IFDEF USE_LAPE} + , lpparser, lpcompiler, lptypes, lpvartypes, + lpeval, lpinterpreter, lpdisassembler + {$ENDIF}; const m_Status = 0; //Data = PChar to new status @@ -232,6 +236,24 @@ type end; {$ENDIF} + {$IFDEF USE_LAPE} + { TLPThread } + TLPThread = class(TMThread) + protected + procedure LoadPlugin(plugidx: integer); override; + public + Parser: TLapeTokenizerString; + Compiler: TLapeCompiler; + constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); + destructor Destroy; override; + procedure SetScript(Script: string); override; + procedure Execute; override; + procedure Terminate; override; + function OnFindFile(Sender: TLapeCompiler; var FileName: lpString): TLapeTokenizerBase; + function OnHandleDirective(Sender: TLapeCompiler; Directive, Argument: lpString; InPeek: Boolean): Boolean; + end; + {$ENDIF} + threadvar CurrThread : TMThread; @@ -681,7 +703,6 @@ begin end; end; - procedure TPSThread.LoadPlugin(plugidx: integer); var i: integer; @@ -1188,6 +1209,175 @@ begin end; {$ENDIF} +{$IFDEF USE_LAPE} +{ TLPThread } + +type + PBoolean = ^Boolean; + PStringArray = ^TStringArray; + PBmpMirrorStyle = ^TBmpMirrorStyle; + PPointArray = ^TPointArray; + P2DIntArray = ^T2DIntArray; + PCanvas = ^TCanvas; + P2DPointArray = ^T2DPointArray; + PMask = ^TMask; + PBox = ^TBox; + PTarget_Exported = ^TTarget_Exported; + PIntegerArray = ^TIntegerArray; + PExtendedArray = ^TExtendedArray; + PFont = ^TFont; +// PStrExtr = ^TStrExtr; + PReplaceFlags = ^TReplaceFlags; + PClickType = ^TClickType; + P2DExtendedArray = ^T2DExtendedArray; + PMDTM = ^TMDTM; + PMDTMPoint = ^TMDTMPoint; + PSDTM = ^TSDTM; + +//Generate these wrappers with a script -Dg +//{$I LPInc/Wrappers/other.inc} +//{$I LPInc/Wrappers/settings.inc} +//{$I LPInc/Wrappers/bitmap.inc} +//{$I LPInc/Wrappers/window.inc} +//{$I LPInc/Wrappers/tpa.inc} +//{$I LPInc/Wrappers/strings.inc} +//{$I LPInc/Wrappers/colour.inc} +//{$I LPInc/Wrappers/colourconv.inc} +//{$I LPInc/Wrappers/crypto.inc} +//{$I LPInc/Wrappers/math.inc} +//{$I LPInc/Wrappers/mouse.inc} +//{$I LPInc/Wrappers/file.inc} +//{$I LPInc/Wrappers/keyboard.inc} +//{$I LPInc/Wrappers/dtm.inc} +//{$I LPInc/Wrappers/ocr.inc} +//{$I LPInc/Wrappers/internets.inc} + +constructor TLPThread.Create(CreateSuspended: Boolean; TheSyncInfo: PSyncInfo; plugin_dir: string); +var + I: integer; + Fonts: TMFonts; +begin + inherited Create(CreateSuspended, TheSyncInfo, plugin_dir); + + Parser := TLapeTokenizerString.Create(''); + Compiler := TLapeCompiler.Create(Parser); + Compiler.OnFindFile := @OnFindFile; + Compiler.OnHandleDirective := @OnHandleDirective; + Fonts := Client.MOCR.Fonts; + with Compiler do + begin + for I := Fonts.Count - 1 downto 0 do + addGlobalVar(Fonts[I].Name, Fonts[I].Name); + + for I := 0 to High(VirtualKeys) do + addGlobalVar(VirtualKeys[I].Key, Format('VK_%S', [VirtualKeys[i].Str])); + + {$I LPInc/lpdefines.inc} + {$I LPInc/lpcompile.inc} + + {$I LPInc/lpexportedmethods.inc} + end; +end; + +destructor TLPThread.Destroy; +begin + try + {if (Compiler <> nil) then + Compiler.Free;} + + if (Parser <> nil) then + Parser.Free; + except + on E: Exception do + psWriteln('Exception TLPThread.Destroy: ' + e.message); + end; + + inherited Destroy; +end; + +procedure TLPThread.SetScript(Script: string); +begin + Parser.Doc := Script; +end; + +function TLPThread.OnFindFile(Sender: TLapeCompiler; var FileName: lpString): TLapeTokenizerBase; +begin + Result := nil; + FileName := IncludePath + FileName; +end; + +function TLPThread.OnHandleDirective(Sender: TLapeCompiler; Directive, Argument: lpString; InPeek: Boolean): Boolean; +var + plugin_idx: integer; +begin + if (Directive = 'loadlib') then + begin + if (Argument <> '') then + begin + plugin_idx := PluginsGlob.LoadPlugin(Argument); + if (plugin_idx >= 0) then + begin + LoadPlugin(plugin_idx); + Result := True; + end else + psWriteln(Format('Your DLL %s has not been found', [Argument])) + end else + psWriteln('Your LoadLib directive has no params, thus cannot find the plugin'); + end; +end; + +procedure TLPThread.LoadPlugin(plugidx: integer); +var + I: integer; +begin + with PluginsGlob.MPlugins[plugidx] do + begin + for i := 0 to TypesLen -1 do + with Types[I] do + Compiler.addGlobalType(TypeDef, TypeName); + + for i := 0 to MethodLen - 1 do + with Methods[i] do + Compiler.addGlobalFunc(FuncStr, FuncPtr); + end; +end; + +procedure TLPThread.Execute; + function CombineDeclArray(a, b: TLapeDeclArray): TLapeDeclArray; + var + i, l: Integer; + begin + Result := a; + l := Length(a); + SetLength(Result, l + Length(b)); + for i := High(b) downto 0 do + Result[l + i] := b[i]; + end; +begin + CurrThread := self; + try + Starttime := lclintf.GetTickCount; + if Compiler.Compile() then + begin + //DisassembleCode(Compiler.Emitter.Code, CombineDeclArray(Compiler.ManagedDeclarations.getByClass(TLapeGlobalVar), Compiler.GlobalDeclarations.getByClass(TLapeGlobalVar))); + psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - Starttime) + ' ms.'); + if CompileOnly then + Exit; + RunCode(Compiler.Emitter.Code); + psWriteln('Successfully executed.'); + end else + psWriteln('Compiling failed.'); + except + on E : Exception do + psWriteln('Exception in Script: ' + e.message); + end; +end; + +procedure TLPThread.Terminate; +begin +end; +{$ENDIF} + initialization PluginsGlob := TMPlugins.Create; libcpascal:= 0; diff --git a/Units/lape b/Units/lape new file mode 160000 index 0000000..da9afa0 --- /dev/null +++ b/Units/lape @@ -0,0 +1 @@ +Subproject commit da9afa0b0461322db5c2d6cf8979e5b39004089f