moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-27 19:42:22 -05:00
Code Issues Releases Wiki Activity

Lape Integration, TLPThread work

Browse Source
This commit is contained in:
John P (Dgby714) 2011-06-16 21:26:03 -04:00 committed by Merlijn Wajer
parent ecab4d5801
commit e5812a8000
8 changed files with 432 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Projects/Simba/Simba.inc
View File

@ -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

58
Projects/Simba/simbaunit.lfm
View File

@ -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

85
Projects/Simba/simbaunit.pas
View File

@ -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;

0
Units/MMLAddon/LPInc/Wrappers/GENERATE THESE! Normal file
View File

89
Units/MMLAddon/LPInc/lpcompile.inc Normal file
View File

@ -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 <http://www.gnu.org/licenses/>.
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');

39
Units/MMLAddon/LPInc/lpdefines.inc Normal file
View File

@ -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 <http://www.gnu.org/licenses/>.
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 }

24
Units/MMLAddon/LPInc/lpexportedmethods.inc Normal file
View File

@ -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 <http://www.gnu.org/licenses/>.
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...

198
Units/MMLAddon/mmlpsthread.pas
View File

@ -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;