diff --git a/Projects/SAMufasaGUI/project1.lpi b/Projects/SAMufasaGUI/project1.lpi index 56b62bc..480e118 100644 --- a/Projects/SAMufasaGUI/project1.lpi +++ b/Projects/SAMufasaGUI/project1.lpi @@ -7,7 +7,7 @@ <UseXPManifest Value="True"/> - <ActiveEditorIndexAtStart Value="8"/> + <ActiveEditorIndexAtStart Value="7"/> </General> <VersionInfo> <ProjectVersion Value=""/> @@ -33,13 +33,13 @@ <PackageName Value="LCL"/> </Item2> </RequiredPackages> - <Units Count="64"> + <Units Count="66"> <Unit0> <Filename Value="project1.lpr"/> <IsPartOfProject Value="True"/> <UnitName Value="project1"/> <CursorPos X="13" Y="17"/> - <TopLine Value="7"/> + <TopLine Value="1"/> <EditorIndex Value="0"/> <UsageCount Value="70"/> <Loaded Value="True"/> @@ -171,8 +171,8 @@ <ResourceBaseClass Value="Form"/> <UnitName Value="TestUnit"/> <CursorPos X="19" Y="271"/> - <TopLine Value="259"/> - <EditorIndex Value="7"/> + <TopLine Value="255"/> + <EditorIndex Value="6"/> <UsageCount Value="36"/> <Loaded Value="True"/> </Unit18> @@ -304,7 +304,7 @@ <UnitName Value="Client"/> <CursorPos X="25" Y="4"/> <TopLine Value="4"/> - <EditorIndex Value="5"/> + <EditorIndex Value="4"/> <UsageCount Value="35"/> <Loaded Value="True"/> </Unit37> @@ -313,8 +313,8 @@ <IsPartOfProject Value="True"/> <UnitName Value="MufasaTypes"/> <CursorPos X="4" Y="26"/> - <TopLine Value="12"/> - <EditorIndex Value="4"/> + <TopLine Value="1"/> + <EditorIndex Value="3"/> <UsageCount Value="35"/> <Loaded Value="True"/> </Unit38> @@ -339,7 +339,7 @@ <UnitName Value="Window"/> <CursorPos X="8" Y="262"/> <TopLine Value="255"/> - <EditorIndex Value="6"/> + <EditorIndex Value="5"/> <UsageCount Value="35"/> <Loaded Value="True"/> </Unit41> @@ -377,7 +377,7 @@ <UnitName Value="finder"/> <CursorPos X="24" Y="130"/> <TopLine Value="111"/> - <EditorIndex Value="3"/> + <EditorIndex Value="2"/> <UsageCount Value="28"/> <Loaded Value="True"/> </Unit46> @@ -406,9 +406,9 @@ <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="mmlpsthread"/> - <CursorPos X="23" Y="160"/> - <TopLine Value="150"/> - <EditorIndex Value="8"/> + <CursorPos X="11" Y="46"/> + <TopLine Value="31"/> + <EditorIndex Value="7"/> <UsageCount Value="24"/> <Loaded Value="True"/> </Unit50> @@ -417,7 +417,7 @@ <UnitName Value="uPSComponent"/> <CursorPos X="21" Y="193"/> <TopLine Value="183"/> - <EditorIndex Value="13"/> + <EditorIndex Value="9"/> <UsageCount Value="13"/> <Loaded Value="True"/> </Unit51> @@ -425,34 +425,28 @@ <Filename Value="../../../FPC/FPCCheckout/rtl/objpas/classes/classesh.inc"/> <CursorPos X="94" Y="494"/> <TopLine Value="489"/> - <EditorIndex Value="12"/> <UsageCount Value="13"/> - <Loaded Value="True"/> </Unit52> <Unit53> <Filename Value="../../../FPC/FPCCheckout/rtl/objpas/types.pp"/> <UnitName Value="types"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <EditorIndex Value="11"/> <UsageCount Value="12"/> - <Loaded Value="True"/> </Unit53> <Unit54> <Filename Value="../../../FPC/FPCCheckout/rtl/objpas/typinfo.pp"/> <UnitName Value="typinfo"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <EditorIndex Value="10"/> <UsageCount Value="12"/> - <Loaded Value="True"/> </Unit54> <Unit55> <Filename Value="../../Units/PascalScript/uPSC_forms.pas"/> <UnitName Value="uPSC_forms"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <EditorIndex Value="9"/> + <EditorIndex Value="8"/> <UsageCount Value="12"/> <Loaded Value="True"/> </Unit55> @@ -469,9 +463,7 @@ <UnitName Value="LResources"/> <CursorPos X="3" Y="1396"/> <TopLine Value="1396"/> - <EditorIndex Value="2"/> <UsageCount Value="12"/> - <Loaded Value="True"/> </Unit57> <Unit58> <Filename Value="../../../lazarus/components/synedit/synmemo.pas"/> @@ -515,8 +507,22 @@ <TopLine Value="124"/> <UsageCount Value="10"/> </Unit63> + <Unit64> + <Filename Value="../../Units/PascalScript/uPSC_std.pas"/> + <UnitName Value="uPSC_std"/> + <CursorPos X="35" Y="8"/> + <TopLine Value="1"/> + <UsageCount Value="10"/> + </Unit64> + <Unit65> + <Filename Value="../../Units/PascalScript/uPSC_controls.pas"/> + <UnitName Value="uPSC_controls"/> + <CursorPos X="1" Y="1"/> + <TopLine Value="11"/> + <UsageCount Value="10"/> + </Unit65> </Units> - <JumpHistory Count="16" HistoryIndex="15"> + <JumpHistory Count="18" HistoryIndex="17"> <Position1> <Filename Value="testunit.pas"/> <Caret Line="274" Column="26" TopLine="258"/> @@ -543,44 +549,52 @@ </Position6> <Position7> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="8" Column="73" TopLine="22"/> + <Caret Line="30" Column="45" TopLine="22"/> </Position7> <Position8> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="30" Column="45" TopLine="22"/> + <Caret Line="225" Column="50" TopLine="217"/> </Position8> <Position9> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="225" Column="50" TopLine="217"/> + <Caret Line="227" Column="5" TopLine="219"/> </Position9> <Position10> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="227" Column="5" TopLine="219"/> + <Caret Line="53" Column="19" TopLine="40"/> </Position10> <Position11> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="53" Column="19" TopLine="40"/> + <Filename Value="testunit.pas"/> + <Caret Line="279" Column="3" TopLine="270"/> </Position11> <Position12> <Filename Value="testunit.pas"/> - <Caret Line="279" Column="3" TopLine="270"/> + <Caret Line="271" Column="19" TopLine="259"/> </Position12> <Position13> - <Filename Value="testunit.pas"/> - <Caret Line="271" Column="19" TopLine="259"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="65" Column="26" TopLine="22"/> </Position13> <Position14> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="65" Column="26" TopLine="22"/> + <Caret Line="49" Column="15" TopLine="21"/> </Position14> <Position15> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="49" Column="15" TopLine="21"/> + <Caret Line="55" Column="16" TopLine="26"/> </Position15> <Position16> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="55" Column="16" TopLine="26"/> + <Caret Line="7" Column="22" TopLine="1"/> </Position16> + <Position17> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="45" Column="74" TopLine="29"/> + </Position17> + <Position18> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="198" Column="19" TopLine="183"/> + </Position18> </JumpHistory> </ProjectOptions> <CompilerOptions> diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index dee8699..ed7cf02 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -1,245 +1,246 @@ -unit mmlpsthread; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,SynMemo; - -type - - { TMMLPSThread } - - TMMLPSThread = class(TThread) - protected -// PSScript : TPSScript; -// PSClient : TPSScript; -// Client: TClient; -// DebugTo : TStrings; - Client : TClient; - PSScript : TPSScript; - DebugTo : TSynMemo; - procedure OnCompile(Sender: TPSScript); - procedure AfterExecute(Sender : TPSScript); - function RequireFile(Sender: TObject; const OriginFileName: String; - var FileName, OutPut: string): Boolean; - procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler); - procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); - procedure OutputMessages; - procedure Execute; override; - public - procedure SetPSScript(Script : string); - procedure SetDebug( Strings : TSynMemo ); - function SetClientInfo : boolean; -// function CompilePSScript : boolean; -// function - constructor Create(CreateSuspended: Boolean); - destructor Destroy; - end; - -implementation -uses - MufasaTypes,{$ifdef mswindows}windows,{$endif} - uPSC_std, uPSC_Controls,uPSC_Classes,uPSC_Graphics,uPSC_stdctrls,uPSC_Forms,uPSC_extctrls, //Compile-libs - uPSR_std, uPSR_Controls,uPSR_Classes,uPSR_Graphics,uPSR_stdctrls,uPSR_Forms,uPSR_extctrls; //Runtime-libs - - -threadvar - CurrThread : TMMLPSThread; - -{Some General PS Functions here} -procedure Writeln(str : string); -begin; - if CurrThread.DebugTo <> nil then - CurrThread.DebugTo.Lines.Add(Str); - //Just overwriting itz.. soz. -end; - -function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; -var - i : integer; -begin; - Writeln('We have a length of: ' + inttostr(length(v))); - Try - Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname)); - Except - Writeln('We has some errors :-('); - end; -end; - -{ - Note to Raymond: For PascalScript, Create it on the .Create, - Execute it on the .Execute, and don't forget to Destroy it on .Destroy. - - Furthermore, all the wrappers can be in the unit "implementation" section. - Better still to create an .inc for it, otherwise this unit will become huge. - (You can even split up the .inc's in stuff like color, bitmap, etc. ) - - Also, don't add PS to this unit, but make a seperate unit for it. - Unit "MMLPSThread", perhaps? - - See the TestUnit for use of this thread, it's pretty straightforward. - - It may also be wise to turn the "Importing of wrappers" into an include as - well, it will really make the unit more straightforward to use and read. -} - - -constructor TMMLPSThread.Create(CreateSuspended : boolean); -begin - if Client <> nil then - Writeln('ThreadClient seems to be set, so not recreating it.') //reset client to defaults? - //ThreadClient.ResetToDefaults - else - Client := TClient.Create; - if PSScript <> nil then - PSScript.Free; - // Create Stuff here - PSScript := TPSScript.Create(nil); - PSScript.UsePreProcessor:= True; - PSScript.OnNeedFile := @RequireFile; - - - PSScript.OnCompile:= @OnCompile; - PSScript.OnCompImport:= @OnCompImport; - PSScript.OnExecImport:= @OnExecImport; - PSScript.OnAfterExecute:= @AfterExecute; - {$IFDEF CPU386 } - PSScript.Defines.Add ('CPU386'); - {$ENDIF } - PSScript.Defines.Add ('MUFASA'); - PSScript.Defines.Add ('COGAT'); - PSScript.Defines.Add ('RAYMONDPOWNS'); - {$IFDEF MSWINDOWS } - PSScript.Defines.Add ('MSWINDOWS'); - PSScript.Defines.Add ('WIN32'); - PSScript.Defines.Add ('WINDOWS'); - {$ENDIF } - {$IFDEF LINUX } - PSScript.Defines.Add ('LINUX'); - {$ENDIF } - FreeOnTerminate := True; - inherited Create(CreateSuspended); -end; - -destructor TMMLPSThread.Destroy; -begin - Client.Free; - PSScript.Free; - inherited Destroy; -end; - -procedure TMMLPSThread.OnCompile(Sender: TPSScript); -begin - //Here we add all the initalizing, of BMPArray etc - Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); - Sender.AddFunction(@Writeln,'procedure writeln(s : string);'); - //Also the functions get added into the engine, right here. -end; - -procedure TMMLPSThread.AfterExecute(Sender: TPSScript); -begin - //Here we add all the Script-freeing-leftovers (like BMParray etc) -end; - -function TMMLPSThread.RequireFile(Sender: TObject; - const OriginFileName: String; var FileName, OutPut: string): Boolean; -begin - -end; - -procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler); -begin - SIRegister_Std(x); - SIRegister_Controls(x); - SIRegister_Classes(x, true); - SIRegister_Graphics(x, true); - SIRegister_stdctrls(x); - SIRegister_Forms(x); - SIRegister_ExtCtrls(x); -end; - -procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec; - x: TPSRuntimeClassImporter); -begin - RIRegister_Std(x); - RIRegister_Classes(x, True); - RIRegister_Controls(x); - RIRegister_Graphics(x, True); - RIRegister_stdctrls(x); - RIRegister_Forms(x); - RIRegister_ExtCtrls(x); -end; - -procedure TMMLPSThread.OutputMessages; -var - l: Longint; - b: Boolean; -begin - b := False; - for l := 0 to PSScript.CompilerMessageCount - 1 do - begin - Writeln(PSScript.CompilerErrorToStr(l)); - if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then - begin - b := True; -// FormMain.CurrSynEdit.SelStart := PSScript.CompilerMessages[l].Pos; - - end; - end; -end; - -procedure TMMLPSThread.Execute; -var - time, i, ii: Integer; -begin; - CurrThread := Self; - time := GetTickCount; - try - if PSScript.Compile then - begin - OutputMessages; - Writeln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.'); -// if not (ScriptState = SCompiling) then - if not PSScript.Execute then - begin -// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition; - Writeln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.' - +Inttostr(PSScript.ExecErrorByteCodePosition)); - end else Writeln('Succesfully executed'); - end else - begin - OutputMessages; - Writeln('Compiling failed'); - end; - except - on E : Exception do - Writeln('Error: ' + E.Message); - end; -end; - -procedure TMMLPSThread.SetPSScript(Script: string); -begin - PSScript.Script.Text:= Script; -end; - -procedure TMMLPSThread.SetDebug(Strings: TSynMemo); -begin - DebugTo := Strings; -end; - -function TMMLPSThread.SetClientInfo: boolean; -begin - //Set the client handle, etc -end; - -{ Include stuff here? } - -//{$I inc/colors.inc} -//{$I inc/bitmaps.inc} - - -end. - - +unit mmlpsthread; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,SynMemo; + +type + + { TMMLPSThread } + + TMMLPSThread = class(TThread) + protected +// PSScript : TPSScript; +// PSClient : TPSScript; +// Client: TClient; +// DebugTo : TStrings; + Client : TClient; + PSScript : TPSScript; + DebugTo : TSynMemo; + procedure OnCompile(Sender: TPSScript); + procedure AfterExecute(Sender : TPSScript); + function RequireFile(Sender: TObject; const OriginFileName: String; + var FileName, OutPut: string): Boolean; + procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler); + procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); + procedure OutputMessages; + procedure Execute; override; + public + procedure SetPSScript(Script : string); + procedure SetDebug( Strings : TSynMemo ); + function SetClientInfo : boolean; +// function CompilePSScript : boolean; +// function + constructor Create(CreateSuspended: Boolean); + destructor Destroy; + end; + +implementation +uses + MufasaTypes,{$ifdef mswindows}windows,{$endif} + uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,uPSC_extctrls, //Compile-libs + uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,uPSR_extctrls, //Runtime-libs + lclintf; + + +threadvar + CurrThread : TMMLPSThread; + +{Some General PS Functions here} +procedure Writeln(str : string); +begin; + if CurrThread.DebugTo <> nil then + CurrThread.DebugTo.Lines.Add(Str); + //Just overwriting itz.. soz. +end; + +function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; +var + i : integer; +begin; + Writeln('We have a length of: ' + inttostr(length(v))); + Try + Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname)); + Except + Writeln('We has some errors :-('); + end; +end; + +{ + Note to Raymond: For PascalScript, Create it on the .Create, + Execute it on the .Execute, and don't forget to Destroy it on .Destroy. + + Furthermore, all the wrappers can be in the unit "implementation" section. + Better still to create an .inc for it, otherwise this unit will become huge. + (You can even split up the .inc's in stuff like color, bitmap, etc. ) + + Also, don't add PS to this unit, but make a seperate unit for it. + Unit "MMLPSThread", perhaps? + + See the TestUnit for use of this thread, it's pretty straightforward. + + It may also be wise to turn the "Importing of wrappers" into an include as + well, it will really make the unit more straightforward to use and read. +} + + +constructor TMMLPSThread.Create(CreateSuspended : boolean); +begin + if Client <> nil then + Writeln('ThreadClient seems to be set, so not recreating it.') //reset client to defaults? + //ThreadClient.ResetToDefaults + else + Client := TClient.Create; + if PSScript <> nil then + PSScript.Free; + // Create Stuff here + PSScript := TPSScript.Create(nil); + PSScript.UsePreProcessor:= True; + PSScript.OnNeedFile := @RequireFile; + + + PSScript.OnCompile:= @OnCompile; + PSScript.OnCompImport:= @OnCompImport; + PSScript.OnExecImport:= @OnExecImport; + PSScript.OnAfterExecute:= @AfterExecute; + {$IFDEF CPU386 } + PSScript.Defines.Add ('CPU386'); + {$ENDIF } + PSScript.Defines.Add ('MUFASA'); + PSScript.Defines.Add ('COGAT'); + PSScript.Defines.Add ('RAYMONDPOWNS'); + {$IFDEF MSWINDOWS } + PSScript.Defines.Add ('MSWINDOWS'); + PSScript.Defines.Add ('WIN32'); + PSScript.Defines.Add ('WINDOWS'); + {$ENDIF } + {$IFDEF LINUX } + PSScript.Defines.Add ('LINUX'); + {$ENDIF } + FreeOnTerminate := True; + inherited Create(CreateSuspended); +end; + +destructor TMMLPSThread.Destroy; +begin + Client.Free; + PSScript.Free; + inherited Destroy; +end; + +procedure TMMLPSThread.OnCompile(Sender: TPSScript); +begin + //Here we add all the initalizing, of BMPArray etc + Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); + Sender.AddFunction(@Writeln,'procedure writeln(s : string);'); + //Also the functions get added into the engine, right here. +end; + +procedure TMMLPSThread.AfterExecute(Sender: TPSScript); +begin + //Here we add all the Script-freeing-leftovers (like BMParray etc) +end; + +function TMMLPSThread.RequireFile(Sender: TObject; + const OriginFileName: String; var FileName, OutPut: string): Boolean; +begin + +end; + +procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler); +begin + SIRegister_Std(x); + SIRegister_Controls(x); + SIRegister_Classes(x, true); + SIRegister_Graphics(x, true); + SIRegister_stdctrls(x); + SIRegister_Forms(x); + SIRegister_ExtCtrls(x); +end; + +procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec; + x: TPSRuntimeClassImporter); +begin + RIRegister_Std(x); + RIRegister_Classes(x, True); + RIRegister_Controls(x); + RIRegister_Graphics(x, True); + RIRegister_stdctrls(x); + RIRegister_Forms(x); + RIRegister_ExtCtrls(x); +end; + +procedure TMMLPSThread.OutputMessages; +var + l: Longint; + b: Boolean; +begin + b := False; + for l := 0 to PSScript.CompilerMessageCount - 1 do + begin + Writeln(PSScript.CompilerErrorToStr(l)); + if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then + begin + b := True; +// FormMain.CurrSynEdit.SelStart := PSScript.CompilerMessages[l].Pos; + + end; + end; +end; + +procedure TMMLPSThread.Execute; +var + time, i, ii: Integer; +begin; + CurrThread := Self; + time := lclintf.GetTickCount; + try + if PSScript.Compile then + begin + OutputMessages; + Writeln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.'); +// if not (ScriptState = SCompiling) then + if not PSScript.Execute then + begin +// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition; + Writeln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.' + +Inttostr(PSScript.ExecErrorByteCodePosition)); + end else Writeln('Succesfully executed'); + end else + begin + OutputMessages; + Writeln('Compiling failed'); + end; + except + on E : Exception do + Writeln('Error: ' + E.Message); + end; +end; + +procedure TMMLPSThread.SetPSScript(Script: string); +begin + PSScript.Script.Text:= Script; +end; + +procedure TMMLPSThread.SetDebug(Strings: TSynMemo); +begin + DebugTo := Strings; +end; + +function TMMLPSThread.SetClientInfo: boolean; +begin + //Set the client handle, etc +end; + +{ Include stuff here? } + +//{$I inc/colors.inc} +//{$I inc/bitmaps.inc} + + +end. + +