From 278ab8d88be1bdf14e42e0698a9b6a098aaada2a Mon Sep 17 00:00:00 2001 From: BenLand100 Date: Mon, 25 Jan 2010 17:38:43 +0000 Subject: [PATCH] Split the TMMLPSThread into a superclass (ps independant) TMThread and a subclass (implementing ps) TPSThread. Had to remove (comment out) some threadcalling stuff i don't understand yet. Will reimplement later once i figure it out. git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@466 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- .../Projects/SAMufasaGUI/framescript.lfm | 4 +- .../Projects/SAMufasaGUI/framescript.lrs | 6 +- .../Projects/SAMufasaGUI/framescript.pas | 4 +- .../Projects/SAMufasaGUI/project1.lpi | 234 +++++---- .../Projects/SAMufasaGUI/testunit.lfm | 4 +- .../Projects/SAMufasaGUI/testunit.lrs | 8 +- .../Projects/SAMufasaGUI/testunit.pas | 12 +- .../Units/MMLAddon/PSInc/Wrappers/other.inc | 4 +- .../MMLAddon/PSInc/psexportedmethods.inc | 4 +- .../Units/MMLAddon/mmlpsthread.pas | 446 ++++++++++-------- 10 files changed, 381 insertions(+), 345 deletions(-) diff --git a/branches/script-component/Projects/SAMufasaGUI/framescript.lfm b/branches/script-component/Projects/SAMufasaGUI/framescript.lfm index 9fdb939..e9a8f73 100644 --- a/branches/script-component/Projects/SAMufasaGUI/framescript.lfm +++ b/branches/script-component/Projects/SAMufasaGUI/framescript.lfm @@ -25,7 +25,7 @@ object ScriptFrame: TScriptFrame OnDragDrop = SynEditDragDrop OnDragOver = SynEditDragOver OnKeyDown = SynEditKeyDown - Gutter.Width = 57 + Gutter.Width = 53 Gutter.MouseActions = < item Shift = [] @@ -602,7 +602,7 @@ object ScriptFrame: TScriptFrame Width = 23 end object TSynGutterLineNumber - Width = 17 + Width = 13 MouseActions = <> MarkupInfo.Background = clBtnFace MarkupInfo.Foreground = clNone diff --git a/branches/script-component/Projects/SAMufasaGUI/framescript.lrs b/branches/script-component/Projects/SAMufasaGUI/framescript.lrs index 915e204..9d4bdad 100644 --- a/branches/script-component/Projects/SAMufasaGUI/framescript.lrs +++ b/branches/script-component/Projects/SAMufasaGUI/framescript.lrs @@ -1,3 +1,5 @@ +{ This is an automatically generated lazarus resource file } + LazarusResources.Add('TScriptFrame','FORMDATA',[ 'TPF0'#12'TScriptFrame'#11'ScriptFrame'#4'Left'#2#0#6'Height'#3'H'#1#3'Top'#2 +#0#5'Width'#3#141#1#12'ClientHeight'#3'H'#1#11'ClientWidth'#3#141#1#8'TabOrd' @@ -7,7 +9,7 @@ LazarusResources.Add('TScriptFrame','FORMDATA',[ +'h'#7#7'fpFixed'#12'Font.Quality'#7#16'fqNonAntialiased'#11'ParentColor'#8#10 +'ParentFont'#8#9'PopupMenu'#7#17'Form1.ScriptPopup'#8'TabOrder'#2#0#10'OnDra' +'gDrop'#7#15'SynEditDragDrop'#10'OnDragOver'#7#15'SynEditDragOver'#9'OnKeyDo' - +'wn'#7#14'SynEditKeyDown'#12'Gutter.Width'#2'9'#19'Gutter.MouseActions'#14#1 + +'wn'#7#14'SynEditKeyDown'#12'Gutter.Width'#2'5'#19'Gutter.MouseActions'#14#1 +#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'cc' +'Any'#8'ClickDir'#7#6'cdDown'#7'Command'#2#13#9'MoveCaret'#8#6'Option'#2#0#8 +'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10 @@ -119,7 +121,7 @@ LazarusResources.Add('TScriptFrame','FORMDATA',[ +'d'#7#25'SynEditProcessUserCommand'#19'OnSpecialLineColors'#7#24'SynEditSpec' +'ialLineColors'#14'OnStatusChange'#7#19'SynEditStatusChange'#0#244#18'TSynGu' +'tterPartList'#0#0#15'TSynGutterMarks'#0#5'Width'#2#23#0#0#20'TSynGutterLine' - +'Number'#0#5'Width'#2#17#12'MouseActions'#14#0#21'MarkupInfo.Background'#7#9 + +'Number'#0#5'Width'#2#13#12'MouseActions'#14#0#21'MarkupInfo.Background'#7#9 +'clBtnFace'#21'MarkupInfo.Foreground'#7#6'clNone'#10'DigitCount'#2#2#30'Show' +'OnlyLineNumbersMultiplesOf'#2#1#9'ZeroStart'#8#12'LeadingZeros'#8#0#0#17'TS' +'ynGutterChanges'#0#5'Width'#2#4#13'ModifiedColor'#4#252#233#0#0#10'SavedCol' diff --git a/branches/script-component/Projects/SAMufasaGUI/framescript.pas b/branches/script-component/Projects/SAMufasaGUI/framescript.pas index 4abaf30..d52e966 100644 --- a/branches/script-component/Projects/SAMufasaGUI/framescript.pas +++ b/branches/script-component/Projects/SAMufasaGUI/framescript.pas @@ -69,7 +69,7 @@ type ScriptName : string;//The name of the currently opened/saved file. ScriptDefault : string;//The default script e.g. program new; begin end. ScriptChanged : boolean;//We need this for that little * (edited star). - ScriptThread : TMMLPSThread;//Just one thread for now.. + ScriptThread : TMThread;//Just one thread for now.. FScriptState : TScriptState;//Stores the ScriptState, if you want the Run/Pause/Start buttons to change accordingly, acces through Form1 procedure undo; procedure redo; @@ -353,4 +353,4 @@ initialization {$I framescript.lrs} end. - + \ No newline at end of file diff --git a/branches/script-component/Projects/SAMufasaGUI/project1.lpi b/branches/script-component/Projects/SAMufasaGUI/project1.lpi index 807a915..e6aca29 100644 --- a/branches/script-component/Projects/SAMufasaGUI/project1.lpi +++ b/branches/script-component/Projects/SAMufasaGUI/project1.lpi @@ -10,7 +10,7 @@ <UseXPManifest Value="True"/> - <ActiveEditorIndexAtStart Value="1"/> + <ActiveEditorIndexAtStart Value="8"/> </General> <VersionInfo> <ProjectVersion Value=""/> @@ -139,9 +139,11 @@ <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="TestUnit"/> - <CursorPos X="3" Y="1550"/> - <TopLine Value="1548"/> + <CursorPos X="37" Y="1704"/> + <TopLine Value="1687"/> + <EditorIndex Value="8"/> <UsageCount Value="202"/> + <Loaded Value="True"/> </Unit13> <Unit14> <Filename Value="../Compilertje/Units/CogatUnits/compinput.pas"/> @@ -189,7 +191,7 @@ <UnitName Value="Client"/> <CursorPos X="15" Y="67"/> <TopLine Value="49"/> - <EditorIndex Value="7"/> + <EditorIndex Value="3"/> <UsageCount Value="201"/> <Loaded Value="True"/> </Unit20> @@ -264,9 +266,9 @@ <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="mmlpsthread"/> - <CursorPos X="31" Y="260"/> - <TopLine Value="243"/> - <EditorIndex Value="10"/> + <CursorPos X="26" Y="250"/> + <TopLine Value="225"/> + <EditorIndex Value="6"/> <UsageCount Value="202"/> <Loaded Value="True"/> </Unit30> @@ -348,7 +350,7 @@ <UnitName Value="bitmaps"/> <CursorPos X="12" Y="93"/> <TopLine Value="83"/> - <EditorIndex Value="11"/> + <EditorIndex Value="10"/> <UsageCount Value="200"/> <Loaded Value="True"/> </Unit42> @@ -493,9 +495,11 @@ </Unit63> <Unit64> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/> - <CursorPos X="1" Y="1"/> - <TopLine Value="90"/> + <CursorPos X="23" Y="107"/> + <TopLine Value="95"/> + <EditorIndex Value="9"/> <UsageCount Value="44"/> + <Loaded Value="True"/> </Unit64> <Unit65> <Filename Value="../../Units/PascalScript/uPSCompiler.pas"/> @@ -589,7 +593,7 @@ <UnitName Value="CompPicker"/> <CursorPos X="47" Y="240"/> <TopLine Value="213"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit78> <Unit79> <Filename Value="../../Units/MMLAddon/colourpicker.pas"/> @@ -628,7 +632,7 @@ <Filename Value="../../../usr/lib64/fpc/2.2.4/source/rtl/objpas/classes/classesh.inc"/> <CursorPos X="3" Y="319"/> <TopLine Value="319"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit83> <Unit84> <Filename Value="../../../lazarus/lcl/forms.pp"/> @@ -642,7 +646,7 @@ <UnitName Value="cthreads"/> <CursorPos X="28" Y="1077"/> <TopLine Value="1070"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit85> <Unit86> <Filename Value="../../Units/MMLCore/dtmutil.pas"/> @@ -657,7 +661,7 @@ <UnitName Value="CompMaths"/> <CursorPos X="15" Y="640"/> <TopLine Value="636"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit87> <Unit88> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/dtm.inc"/> @@ -705,11 +709,9 @@ <Filename Value="../../Units/MMLCore/ocr.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="ocr"/> - <CursorPos X="26" Y="742"/> + <CursorPos X="50" Y="739"/> <TopLine Value="720"/> - <EditorIndex Value="1"/> <UsageCount Value="200"/> - <Loaded Value="True"/> </Unit94> <Unit95> <Filename Value="../../Units/PascalScript/uPSR_extctrls.pas"/> @@ -764,9 +766,9 @@ <Unit103> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/window.inc"/> <CursorPos X="12" Y="63"/> - <TopLine Value="30"/> - <EditorIndex Value="5"/> - <UsageCount Value="16"/> + <TopLine Value="29"/> + <EditorIndex Value="1"/> + <UsageCount Value="19"/> <Loaded Value="True"/> </Unit103> <Unit104> @@ -785,13 +787,13 @@ <Filename Value="../../../FPC/FPCCheckout/rtl/inc/threadh.inc"/> <CursorPos X="11" Y="135"/> <TopLine Value="119"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit106> <Unit107> <Filename Value="../../../FPC/FPCCheckout/rtl/inc/thread.inc"/> <CursorPos X="21" Y="152"/> <TopLine Value="152"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit107> <Unit108> <Filename Value="../../../lazarus/lcl/comctrls.pp"/> @@ -841,7 +843,7 @@ <UnitName Value="CodeToolsStrConsts"/> <CursorPos X="28" Y="81"/> <TopLine Value="74"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit114> <Unit115> <Filename Value="../../../lazarus/ide/editoroptions.pp"/> @@ -855,7 +857,7 @@ <UnitName Value="SynEditHighlighter"/> <CursorPos X="28" Y="74"/> <TopLine Value="54"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit116> <Unit117> <Filename Value="../../../lazarus/ide/sourceeditor.pp"/> @@ -886,9 +888,11 @@ <ComponentName Value="ScriptFrame"/> <ResourceBaseClass Value="Frame"/> <UnitName Value="framescript"/> - <CursorPos X="1" Y="101"/> - <TopLine Value="98"/> + <CursorPos X="23" Y="72"/> + <TopLine Value="55"/> + <EditorIndex Value="7"/> <UsageCount Value="200"/> + <Loaded Value="True"/> </Unit120> <Unit121> <Filename Value="../../../lazarus/lcl/include/pagecontrol.inc"/> @@ -933,21 +937,21 @@ <Filename Value="../../../lazarus/lcl/include/menuitem.inc"/> <CursorPos X="3" Y="1400"/> <TopLine Value="1378"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit127> <Unit128> <Filename Value="../../../lazarus/lcl/widgetset/wsmenus.pp"/> <UnitName Value="WSMenus"/> <CursorPos X="1" Y="129"/> <TopLine Value="126"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit128> <Unit129> <Filename Value="../../../lazarus/lcl/lclclasses.pp"/> <UnitName Value="LCLClasses"/> <CursorPos X="5" Y="40"/> <TopLine Value="32"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit129> <Unit130> <Filename Value="../../../lazarus/ide/codeexplorer.pas"/> @@ -957,7 +961,7 @@ <UnitName Value="CodeExplorer"/> <CursorPos X="13" Y="1477"/> <TopLine Value="1466"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit130> <Unit131> <Filename Value="../../../lazarus/ide/keymapping.pp"/> @@ -971,7 +975,7 @@ <UnitName Value="BaseDebugManager"/> <CursorPos X="15" Y="87"/> <TopLine Value="76"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit132> <Unit133> <Filename Value="../../../lazarus/lcl/lmessages.pp"/> @@ -1003,7 +1007,7 @@ <Filename Value="../../../FPC/FPCCheckout/rtl/objpas/classes/lists.inc"/> <CursorPos X="3" Y="626"/> <TopLine Value="624"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit137> <Unit138> <Filename Value="../../../lazarus/lcl/include/tabsheet.inc"/> @@ -1034,14 +1038,14 @@ <UnitName Value="WSExtCtrls"/> <CursorPos X="50" Y="292"/> <TopLine Value="292"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit142> <Unit143> <Filename Value="../../../lazarus/lcl/interfaces/cocoa/cocoawsextctrls.pas"/> <UnitName Value="CocoaWSExtCtrls"/> <CursorPos X="22" Y="72"/> <TopLine Value="59"/> - <UsageCount Value="0"/> + <UsageCount Value="10"/> </Unit143> <Unit144> <Filename Value="../../../lazarus/lcl/interfaces/gtk/gtkwsextctrls.pp"/> @@ -1538,9 +1542,7 @@ <UnitName Value="ocrutil"/> <CursorPos X="52" Y="609"/> <TopLine Value="585"/> - <EditorIndex Value="3"/> <UsageCount Value="37"/> - <Loaded Value="True"/> </Unit216> <Unit217> <Filename Value="../../../Documents/fpc/rtl/objpas/sysutils/filutilh.inc"/> @@ -1589,7 +1591,7 @@ <UnitName Value="framefunctionlist"/> <CursorPos X="26" Y="295"/> <TopLine Value="7"/> - <UsageCount Value="182"/> + <UsageCount Value="186"/> </Unit223> <Unit224> <Filename Value="../../../usr/local/share/lazarus/lcl/comctrls.pp"/> @@ -1616,9 +1618,7 @@ <UnitName Value="fontloader"/> <CursorPos X="59" Y="173"/> <TopLine Value="151"/> - <EditorIndex Value="4"/> <UsageCount Value="12"/> - <Loaded Value="True"/> </Unit227> <Unit228> <Filename Value="../../Units/MMLCore/mufasatypesutil.pas"/> @@ -1646,7 +1646,7 @@ <UnitName Value="simpleanalyzer"/> <CursorPos X="52" Y="104"/> <TopLine Value="193"/> - <UsageCount Value="169"/> + <UsageCount Value="173"/> </Unit231> <Unit232> <Filename Value="../../Units/Misc/mPasLex.pas"/> @@ -1704,10 +1704,10 @@ </Unit239> <Unit240> <Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/> - <CursorPos X="40" Y="59"/> - <TopLine Value="36"/> - <EditorIndex Value="6"/> - <UsageCount Value="27"/> + <CursorPos X="3" Y="100"/> + <TopLine Value="72"/> + <EditorIndex Value="2"/> + <UsageCount Value="30"/> <Loaded Value="True"/> </Unit240> <Unit241> @@ -1723,7 +1723,7 @@ <UnitName Value="updater"/> <CursorPos X="38" Y="211"/> <TopLine Value="65"/> - <UsageCount Value="142"/> + <UsageCount Value="146"/> </Unit242> <Unit243> <Filename Value="updateform.pas"/> @@ -1734,7 +1734,7 @@ <ComponentState Value="1"/> <CursorPos X="111" Y="102"/> <TopLine Value="207"/> - <UsageCount Value="137"/> + <UsageCount Value="141"/> </Unit243> <Unit244> <Filename Value="../../../Documents/lazarus/lcl/fileutil.pas"/> @@ -1855,7 +1855,7 @@ <UnitName Value="simbasettings"/> <CursorPos X="26" Y="9"/> <TopLine Value="11"/> - <UsageCount Value="100"/> + <UsageCount Value="104"/> </Unit261> <Unit262> <Filename Value="../../Units/MMLAddon/settings.pas"/> @@ -1893,7 +1893,7 @@ <UnitName Value="reportbug"/> <CursorPos X="53" Y="23"/> <TopLine Value="21"/> - <UsageCount Value="83"/> + <UsageCount Value="87"/> </Unit266> <Unit267> <Filename Value="../../Units/Synapse/synsock.pas"/> @@ -1950,7 +1950,7 @@ <UnitName Value="newinternets"/> <CursorPos X="37" Y="171"/> <TopLine Value="153"/> - <UsageCount Value="79"/> + <UsageCount Value="83"/> </Unit274> <Unit275> <Filename Value="reportbug.lrs"/> @@ -1999,7 +1999,7 @@ <CursorPos X="67" Y="53"/> <TopLine Value="34"/> <EditorIndex Value="0"/> - <UsageCount Value="30"/> + <UsageCount Value="33"/> <Loaded Value="True"/> </Unit281> <Unit282> @@ -2007,8 +2007,8 @@ <UnitName Value="os_linux"/> <CursorPos X="36" Y="69"/> <TopLine Value="56"/> - <EditorIndex Value="9"/> - <UsageCount Value="29"/> + <EditorIndex Value="5"/> + <UsageCount Value="32"/> <Loaded Value="True"/> </Unit282> <Unit283> @@ -2023,8 +2023,8 @@ <UnitName Value="os_windows"/> <CursorPos X="22" Y="164"/> <TopLine Value="155"/> - <EditorIndex Value="12"/> - <UsageCount Value="25"/> + <EditorIndex Value="11"/> + <UsageCount Value="28"/> <Loaded Value="True"/> </Unit284> <Unit285> @@ -2047,7 +2047,7 @@ <UnitName Value="libloader"/> <CursorPos X="1" Y="149"/> <TopLine Value="128"/> - <UsageCount Value="37"/> + <UsageCount Value="41"/> </Unit287> <Unit288> <Filename Value="../../Units/MMLAddon/tpa.pas"/> @@ -2060,8 +2060,8 @@ <Filename Value="../../Units/PascalScript/x86.inc"/> <CursorPos X="8" Y="157"/> <TopLine Value="140"/> - <EditorIndex Value="8"/> - <UsageCount Value="15"/> + <EditorIndex Value="4"/> + <UsageCount Value="18"/> <Loaded Value="True"/> </Unit289> <Unit290> @@ -2082,131 +2082,129 @@ <UnitName Value="tpa"/> <CursorPos X="70" Y="1393"/> <TopLine Value="1364"/> - <EditorIndex Value="2"/> <UsageCount Value="12"/> - <Loaded Value="True"/> </Unit292> </Units> <JumpHistory Count="30" HistoryIndex="29"> <Position1> - <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/window.inc"/> - <Caret Line="1" Column="1" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="223" Column="14" TopLine="206"/> </Position1> <Position2> - <Filename Value="../../Units/PascalScript/x86.inc"/> - <Caret Line="592" Column="60" TopLine="584"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="239" Column="11" TopLine="229"/> </Position2> <Position3> - <Filename Value="../../Units/MMLCore/client.pas"/> - <Caret Line="36" Column="17" TopLine="27"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="377" Column="34" TopLine="349"/> </Position3> <Position4> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="48" Column="50" TopLine="34"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="118" Column="15" TopLine="101"/> </Position4> <Position5> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="345" Column="27" TopLine="311"/> + <Caret Line="129" Column="63" TopLine="101"/> </Position5> <Position6> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="69" Column="36" TopLine="56"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="369" Column="14" TopLine="352"/> </Position6> <Position7> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="201" Column="29" TopLine="195"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="99" Column="70" TopLine="67"/> </Position7> <Position8> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="372" Column="45" TopLine="348"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="261" Column="8" TopLine="246"/> </Position8> <Position9> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="202" Column="29" TopLine="177"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="308" Column="4" TopLine="292"/> </Position9> <Position10> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="346" Column="59" TopLine="328"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="310" Column="16" TopLine="297"/> </Position10> <Position11> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="47" Column="34" TopLine="34"/> + <Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/> + <Caret Line="59" Column="40" TopLine="36"/> </Position11> <Position12> - <Filename Value="../../Units/MMLCore/tpa.pas"/> - <Caret Line="14" Column="67" TopLine="23"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="127" Column="19" TopLine="101"/> </Position12> <Position13> - <Filename Value="../../Units/MMLCore/tpa.pas"/> - <Caret Line="76" Column="21" TopLine="58"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="59" Column="22" TopLine="42"/> </Position13> <Position14> - <Filename Value="../../Units/MMLCore/tpa.pas"/> - <Caret Line="77" Column="21" TopLine="58"/> + <Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/> + <Caret Line="24" Column="28" TopLine="7"/> </Position14> <Position15> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="31" Column="54" TopLine="23"/> + <Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/> + <Caret Line="30" Column="24" TopLine="13"/> </Position15> <Position16> - <Filename Value="../../Units/MMLCore/ocrutil.pas"/> - <Caret Line="85" Column="37" TopLine="69"/> + <Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/> + <Caret Line="24" Column="3" TopLine="7"/> </Position16> <Position17> - <Filename Value="../../Units/MMLCore/ocrutil.pas"/> - <Caret Line="25" Column="12" TopLine="12"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="134" Column="37" TopLine="243"/> </Position17> <Position18> - <Filename Value="../../Units/MMLCore/ocrutil.pas"/> - <Caret Line="26" Column="12" TopLine="12"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="387" Column="6" TopLine="374"/> </Position18> <Position19> - <Filename Value="../../Units/MMLCore/ocrutil.pas"/> - <Caret Line="20" Column="13" TopLine="12"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="644" Column="12" TopLine="622"/> </Position19> <Position20> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="656" Column="23" TopLine="625"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="133" Column="36" TopLine="113"/> </Position20> <Position21> - <Filename Value="../../Units/MMLCore/fontloader.pas"/> - <Caret Line="63" Column="34" TopLine="37"/> + <Filename Value="framescript.pas"/> + <Caret Line="101" Column="1" TopLine="98"/> </Position21> <Position22> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="710" Column="61" TopLine="692"/> + <Filename Value="framescript.pas"/> + <Caret Line="73" Column="41" TopLine="54"/> </Position22> <Position23> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="55" Column="42" TopLine="37"/> + <Filename Value="testunit.pas"/> + <Caret Line="1550" Column="3" TopLine="1548"/> </Position23> <Position24> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="714" Column="22" TopLine="692"/> + <Filename Value="testunit.pas"/> + <Caret Line="541" Column="21" TopLine="518"/> </Position24> <Position25> - <Filename Value="../../Units/MMLCore/fontloader.pas"/> - <Caret Line="55" Column="29" TopLine="37"/> + <Filename Value="testunit.pas"/> + <Caret Line="536" Column="30" TopLine="519"/> </Position25> <Position26> - <Filename Value="../../Units/MMLCore/fontloader.pas"/> - <Caret Line="79" Column="10" TopLine="61"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="97" Column="54" TopLine="73"/> </Position26> <Position27> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="729" Column="26" TopLine="702"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="240" Column="69" TopLine="223"/> </Position27> <Position28> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="712" Column="8" TopLine="703"/> + <Filename Value="testunit.pas"/> + <Caret Line="550" Column="46" TopLine="532"/> </Position28> <Position29> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="721" Column="23" TopLine="703"/> + <Filename Value="testunit.pas"/> + <Caret Line="636" Column="33" TopLine="613"/> </Position29> <Position30> - <Filename Value="../../Units/MMLCore/ocr.pas"/> - <Caret Line="751" Column="10" TopLine="720"/> + <Filename Value="testunit.pas"/> + <Caret Line="1439" Column="24" TopLine="1422"/> </Position30> </JumpHistory> </ProjectOptions> diff --git a/branches/script-component/Projects/SAMufasaGUI/testunit.lfm b/branches/script-component/Projects/SAMufasaGUI/testunit.lfm index e19d125..f08b393 100644 --- a/branches/script-component/Projects/SAMufasaGUI/testunit.lfm +++ b/branches/script-component/Projects/SAMufasaGUI/testunit.lfm @@ -1,7 +1,7 @@ object Form1: TForm1 - Left = 1343 + Left = 593 Height = 557 - Top = 181 + Top = 321 Width = 734 ActiveControl = ScriptPanel Caption = 'THA FUKING SIMBA' diff --git a/branches/script-component/Projects/SAMufasaGUI/testunit.lrs b/branches/script-component/Projects/SAMufasaGUI/testunit.lrs index 6839c02..44be78d 100644 --- a/branches/script-component/Projects/SAMufasaGUI/testunit.lrs +++ b/branches/script-component/Projects/SAMufasaGUI/testunit.lrs @@ -1,10 +1,10 @@ { This is an automatically generated lazarus resource file } LazarusResources.Add('TForm1','FORMDATA',[ - 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'?'#5#6'Height'#3'-'#2#3'Top'#3#181#0#5'Wi' - +'dth'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING' - +' SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4 - +'Menu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9 + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'Q'#2#6'Height'#3'-'#2#3'Top'#3'A'#1#5'Wid' + +'th'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING ' + +'SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4'M' + +'enu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9 +'OnDestroy'#7#11'FormDestroy'#10'OnShortCut'#7#13'FormShortCuts'#8'Position' +#7#14'poScreenCenter'#10'LCLVersion'#6#6'0.9.29'#7'Visible'#9#0#8'TToolBar'#8 +'ToolBar1'#4'Left'#2#0#6'Height'#2#24#3'Top'#2#0#5'Width'#3#222#2#7'Caption' diff --git a/branches/script-component/Projects/SAMufasaGUI/testunit.pas b/branches/script-component/Projects/SAMufasaGUI/testunit.pas index f344a3d..14ac0c1 100644 --- a/branches/script-component/Projects/SAMufasaGUI/testunit.pas +++ b/branches/script-component/Projects/SAMufasaGUI/testunit.pas @@ -533,12 +533,12 @@ begin PluginsPath := LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS)); ScriptErrorLine:= -1; CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; - ScriptThread := TMMLPSThread.Create(True,@CurrentSyncInfo,PluginsPath); + ScriptThread := TPSThread.Create(True,@CurrentSyncInfo,PluginsPath); {$IFNDEF TERMINALWRITELN} ScriptThread.SetDebug(@formWriteln); ScriptThread.DebugMemo := Self.Memo1; {$ENDIF} - ScriptThread.SetPSScript(CurrScript.SynEdit.Lines.Text); + ScriptThread.SetScript(CurrScript.SynEdit.Lines.Text); DbgImgInfo.DispSize := @DebugImgForm.DispSize; DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm; DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp; @@ -627,13 +627,13 @@ begin end; ss_Running: begin - ScriptThread.PSScript.Stop; + ScriptThread.Terminate; ScriptState := ss_Stopping; end; ss_Paused: begin ScriptThread.Resume; - ScriptThread.PSScript.Stop; + ScriptThread.Terminate; ScriptState:= ss_Stopping; end; end; @@ -1436,7 +1436,7 @@ var begin if frmFunctionList.FunctionList.Items.Count = 0 then begin; - Methods := TMMLPSThread.GetExportedMethods; + Methods := TMThread.GetExportedMethods; Tree := frmFunctionList.FunctionList; Tree.Items.Clear; Sections := TStringList.Create; @@ -1701,7 +1701,7 @@ end; procedure TForm1.SafeCallThread; begin Writeln('Executing : ' + CurrentSyncInfo.MethodName); - mmlpsthread.CurrThread := TMMLPSTHREAD(CurrentSyncInfo.OldThread); + mmlpsthread.CurrThread := TMThread(CurrentSyncInfo.OldThread); with CurrentSyncInfo.PSScript do begin; OnLine:=@OnLinePSScript; diff --git a/branches/script-component/Units/MMLAddon/PSInc/Wrappers/other.inc b/branches/script-component/Units/MMLAddon/PSInc/Wrappers/other.inc index 117220e..d07e6a0 100644 --- a/branches/script-component/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/branches/script-component/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -33,7 +33,7 @@ begin if t > 50 then begin; EndTime := GetTickCount + t; - while (CurrThread.PSScript.Exec.Status = isRunning) and (GetTickCount < EndTime) do + while {(CurrThread.PSScript.Exec.Status = isRunning) and }(GetTickCount < EndTime) do Sleep(16); end else begin @@ -104,7 +104,7 @@ end; procedure TerminateScript; begin; - CurrThread.PSScript.Stop; + CurrThread.Terminate; end; function GetTimeRunning: LongWord; begin; diff --git a/branches/script-component/Units/MMLAddon/PSInc/psexportedmethods.inc b/branches/script-component/Units/MMLAddon/PSInc/psexportedmethods.inc index 0c0e489..72c8735 100644 --- a/branches/script-component/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/branches/script-component/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -21,7 +21,7 @@ psexportedmethods.inc for the Mufasa Macro Library } -AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); +//AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); AddFunction(nil,'procedure Writeln(x);'); //We use special function for this { DTM } @@ -97,7 +97,7 @@ AddFunction(@DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w, h: intege AddFunction(@DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp: integer);'); AddFunction(@GetDebugBitmap,'function GetDebugBitmap: integer;'); AddFunction(@Random,'function Random(Int: integer): integer;'); -AddFunction(@NewThreadCall,'function NewThreadCall(procname : string) : cardinal'); +//AddFunction(@NewThreadCall,'function NewThreadCall(procname : string) : cardinal'); AddFunction(@ClearDebug,'procedure ClearDebug;'); diff --git a/branches/script-component/Units/MMLAddon/mmlpsthread.pas b/branches/script-component/Units/MMLAddon/mmlpsthread.pas index 969bfca..d35b341 100644 --- a/branches/script-component/Units/MMLAddon/mmlpsthread.pas +++ b/branches/script-component/Units/MMLAddon/mmlpsthread.pas @@ -74,54 +74,74 @@ type end; TExpMethodArr = array of TExpMethod; - TMMLPSThread = class(TThread) + TMThread = class(TThread) + protected + ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string; + DebugTo: TWritelnProc; + DebugImg : TDbgImgInfo; + PluginsToload : array of integer; + ExportedMethods : TExpMethodArr; + + procedure HandleError(ErrorAtLine,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string); + function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean; + function LoadFile(var filename, contents: string): boolean; + procedure LoadMethods; virtual; abstract; + + public + Client : TClient; + StartTime : LongWord; + DebugMemo : TMemo; + + SyncInfo : PSyncInfo; //We need this for callthreadsafe + ErrorData : PErrorData; //We need this for thread-safety etc + OnError : TOnError; //Error handeler + + procedure SetScript(Script : string); + procedure SetDebug( writelnProc : TWritelnProc ); + procedure SetDbgImg( DebugImageInfo : TDbgImgInfo); + procedure SetPaths(ScriptP,AppP,IncludeP,PluginP,FontP : string); + procedure OnThreadTerminate(Sender: TObject); + procedure SetScript(script: string); virtual; abstract; + procedure Execute; override; abstract; + procedure Terminate; virtual; abstract; + + constructor Create(CreateSuspended: boolean; plugin_dir: string); + destructor Destroy; override; + + class function GetExportedMethods : TExpMethodArr; + end; + + TPSThread = class(TMThread) procedure OnProcessDirective(Sender: TPSPreProcessor; Parser: TPSPascalPreProcessorParser; const Active: Boolean; const DirectiveName, DirectiveParam: string; var Continue: Boolean); function PSScriptFindUnknownFile(Sender: TObject; - const OrginFileName: string; var FileName, Output: string - ): Boolean; + const OrginFileName: string; var FileName, Output: string): Boolean; procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor; Parser: TPSPascalPreProcessorParser; const Active: Boolean; const DirectiveName, DirectiveParam: string; var Continue: Boolean); - private - ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string; - procedure HandleError(ErrorAtLine,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string); protected //DebugTo : TMemo; - DebugTo: TWritelnProc; - DebugImg : TDbgImgInfo; - PluginsToload : Array of integer; - FOnError : TOnError; procedure OnCompile(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 OnThreadTerminate(Sender: TObject); - procedure Execute; override; public - ExportedMethods : TExpMethodArr; PSScript : TPSScript; // Moved to public, as we can't kill it otherwise. - Client : TClient; - StartTime : LongWord; - DebugMemo : TMemo; - SyncInfo : PSyncInfo; //We need this for callthreadsafe - ErrorData : PErrorData; //We need this for thread-safety etc - property OnError : TOnError read FOnError write FOnError; - procedure LoadMethods; - class function GetExportedMethods : TExpMethodArr; - procedure SetPSScript(Script : string); - procedure SetDebug( writelnProc : TWritelnProc ); - procedure SetDbgImg( DebugImageInfo : TDbgImgInfo); - procedure SetPaths(ScriptP,AppP,IncludeP,PluginP,FontP : string); constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); destructor Destroy; override; + procedure SetScript(script: string); override; + procedure Execute; override; + procedure Terminate; override; end; + threadvar - CurrThread : TMMLPSThread; + CurrThread : TMThread; + implementation + uses colour_conv,dtmutil, {$ifdef mswindows}windows,{$endif} @@ -199,27 +219,166 @@ begin Stack.SetAnsiString(-1, MakeString(NewTPSVariantIFC(Stack[Stack.Count-2],false))); end; -function NewThreadCall(Procname : string) : Cardinal; -begin; - result := CurrThread.PSScript.Exec.GetVar(Procname); +{***implementation TMThread***} +constructor TMThread.Create(CreateSuspended: boolean; plugin_dir: string); +begin + Client := TClient.Create(plugin_dir); + ExportedMethods:= GetExportedMethods; + SetLength(PluginsToLoad,0); + FreeOnTerminate := True; + OnTerminate := @OnThreadTerminate; + inherited Create(CreateSuspended); end; -function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; -begin; - CurrThread.SyncInfo^.MethodName:= ProcName; - CurrThread.SyncInfo^.V:= V; - CurrThread.SyncInfo^.PSScript := CurrThread.PSScript; - CurrThread.SyncInfo^.OldThread := CurrThread; - CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod); - Result := CurrThread.SyncInfo^.Res; -{ 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;} +destructor TMThread.Destroy; +begin + SetLength(PluginsToLoad,0); + Client.Free; + inherited Destroy; end; +procedure TMThread.HandleError(ErrorAtLine, ErrorPosition: integer; ErrorStr: string; ErrorType: TErrorType; ErrorModule : string); +begin + if OnError = nil then + exit; + ErrorData^.Line:= ErrorAtLine; + ErrorData^.Position:= ErrorPosition; + ErrorData^.Error:= ErrorStr; + ErrorData^.ErrType:= ErrorType; + ErrorData^.Module:= ErrorModule; + ErrorData^.IncludePath:= IncludePath; + CurrThread.Synchronize(OnError); //what does this do??? +end; + +procedure TMThread.OnThreadTerminate(Sender: TObject); +begin + +end; + +function TMThread.ProcessDirective(DirectiveName, DirectiveArgs: string): boolean; +var + plugin_idx, i: integer; +begin + if DirectiveName= 'LOADDLL' then + begin + if DirectiveArgs <> '' then + begin; + plugin_idx:= PluginsGlob.LoadPlugin(DirectiveArgs); + if plugin_idx < 0 then + psWriteln(Format('Your DLL %s has not been found',[DirectiveArgs])) + else + begin; + for i := High(PluginsToLoad) downto 0 do + if PluginsToLoad[i] = plugin_idx then + Exit; + SetLength(PluginsToLoad,Length(PluginsToLoad)+1); + PluginsToLoad[High(PluginsToLoad)]:= plugin_idx; + end; + end; + end; + result:= True; +end; + +function TMThread.LoadFile(var filename, contents: string): boolean; +var + path: string; + f: TFileStream; +begin + if FileExists(filename) then + path:= filename + else + path:= IncludePath + filename; + if not FileExists(path) then + begin + psWriteln(Path + ' doesn''t exist'); + Result := false; + Exit; + end; + try + f:= TFileStream.Create(Path, fmOpenRead or fmShareDenyWrite); + except + Result := false; + exit; + end; + try + try + SetLength(contents, f.Size); + f.Read(contents[1], Length(contents)); + result:= true; + finally + f.free; + end; + except + result:= false; + end; +end; + +procedure TMThread.SetDebug(writelnProc: TWritelnProc); +begin + DebugTo := writelnProc; +end; + +procedure TMThread.SetDbgImg(DebugImageInfo: TDbgImgInfo); +begin + DebugImg := DebugImageInfo; +end; + +procedure TMThread.SetPaths(ScriptP, AppP,IncludeP,PluginP,FontP: string); +begin + AppPath:= AppP; + ScriptPath:= ScriptP; + IncludePath:= IncludeP; + PluginPath:= PluginP; + FontPath:= FontP; +end; + +{$I PSInc/Wrappers/other.inc} +{$I PSInc/Wrappers/bitmap.inc} +{$I PSInc/Wrappers/window.inc} + +{$I PSInc/Wrappers/strings.inc} + +{$I PSInc/Wrappers/colour.inc} +{$I PSInc/Wrappers/math.inc} +{$I PSInc/Wrappers/mouse.inc} +{$I PSInc/Wrappers/file.inc} + +{$I PSInc/Wrappers/keyboard.inc} +{$I PSInc/Wrappers/dtm.inc} +{$I PSInc/Wrappers/ocr.inc} +{$I PSInc/Wrappers/internets.inc} + +class function TMThread.GetExportedMethods: TExpMethodArr; +var + c : integer; + CurrSection : string; + +procedure SetCurrSection(str : string); +begin; + CurrSection := Str; +end; + +procedure AddFunction( Ptr : Pointer; DeclStr : String); +begin; + if c >= 300 then + raise exception.create('PSThread.LoadMethods: Exported more than 300 functions'); + Result[c].FuncDecl:= DeclStr; + Result[c].FuncPtr:= Ptr; + Result[c].Section:= CurrSection; + inc(c); +end; + +begin + c := 0; + CurrSection := 'Other'; + SetLength(Result,300); + + {$i PSInc/psexportedmethods.inc} + + SetLength(Result,c); +end; + +{***implementation TPSThread***} { Note to Raymond: For PascalScript, Create it on the .Create, @@ -238,12 +397,31 @@ end; well, it will really make the unit more straightforward to use and read. } +{function NewThreadCall(Procname : string) : Cardinal; +begin; + result := CurrThread.PSScript.Exec.GetVar(Procname); +end;} -constructor TMMLPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); +{function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; +begin; + CurrThread.SyncInfo^.MethodName:= ProcName; + CurrThread.SyncInfo^.V:= V; + CurrThread.SyncInfo^.PSScript := CurrThread.PSScript; + CurrThread.SyncInfo^.OldThread := CurrThread; + CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod); + Result := CurrThread.SyncInfo^.Res; +// 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;} + + +constructor TPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); begin SyncInfo:= TheSyncInfo; - SetLength(PluginsToLoad,0); - Client := TClient.Create(plugin_dir); PSScript := TPSScript.Create(nil); PSScript.UsePreProcessor:= True; PSScript.OnNeedFile := @RequireFile; @@ -256,99 +434,36 @@ begin OnError:= nil; // Set some defines {$I PSInc/psdefines.inc} - // Load the methods we're going to export - Self.LoadMethods; - - FreeOnTerminate := True; - Self.OnTerminate := @Self.OnThreadTerminate; - - inherited Create(CreateSuspended); + inherited Create(CreateSuspended, plugin_dir); end; -procedure TMMLPSThread.OnThreadTerminate(Sender: TObject); -begin -// Writeln('Terminating the thread'); -end; -destructor TMMLPSThread.Destroy; +destructor TPSThread.Destroy; begin - SetLength(PluginsToLoad,0); - Client.Free; PSScript.Free; inherited; end; -// include PS wrappers -{$I PSInc/Wrappers/other.inc} -{$I PSInc/Wrappers/bitmap.inc} -{$I PSInc/Wrappers/window.inc} - -{$I PSInc/Wrappers/strings.inc} - -{$I PSInc/Wrappers/colour.inc} -{$I PSInc/Wrappers/math.inc} -{$I PSInc/Wrappers/mouse.inc} -{$I PSInc/Wrappers/file.inc} - -{$I PSInc/Wrappers/keyboard.inc} -{$I PSInc/Wrappers/dtm.inc} -{$I PSInc/Wrappers/ocr.inc} -{$I PSInc/Wrappers/internets.inc} - -procedure TMMLPSThread.OnProcessDirective(Sender: TPSPreProcessor; +procedure TPSThread.OnProcessDirective(Sender: TPSPreProcessor; Parser: TPSPascalPreProcessorParser; const Active: Boolean; const DirectiveName, DirectiveParam: string; var Continue: Boolean); begin end; -function TMMLPSThread.PSScriptFindUnknownFile(Sender: TObject; +function TPSThread.PSScriptFindUnknownFile(Sender: TObject; const OrginFileName: string; var FileName, Output: string): Boolean; begin Writeln(OrginFileName + '-' + Output + '-' + FileName); end; -procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor; +procedure TPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor; Parser: TPSPascalPreProcessorParser; const Active: Boolean; const DirectiveName, DirectiveParam: string; var Continue: Boolean); -var - TempNum : integer; - I: integer; begin - if DirectiveName= 'LOADDLL' then - if DirectiveParam <> '' then - begin; - TempNum := PluginsGlob.LoadPlugin(DirectiveParam); - if TempNum < 0 then - psWriteln(Format('Your DLL %s has not been found',[DirectiveParam])) - else - begin; - for i := High(PluginsToLoad) downto 0 do - if PluginsToLoad[i] = TempNum then - Exit; - SetLength(PluginsToLoad,Length(PluginsToLoad)+1); - PluginsToLoad[High(PluginsToLoad)] := TempNum; - end; - end; - Continue:= True; + Continue:= ProcessDirective(DirectiveName, DirectiveParam); end; -procedure TMMLPSThread.HandleError(ErrorAtLine, ErrorPosition: integer; - ErrorStr: string; ErrorType: TErrorType; ErrorModule : string); -begin - if FOnError = nil then - exit; - ErrorData^.Line:= ErrorAtLine; - ErrorData^.Position:= ErrorPosition; - ErrorData^.Error:= ErrorStr; - ErrorData^.ErrType:= ErrorType; - ErrorData^.Module:= ErrorModule; - ErrorData^.IncludePath:= IncludePath; - CurrThread.Synchronize(FOnError); -end; - - - -procedure TMMLPSThread.OnCompile(Sender: TPSScript); +procedure TPSThread.OnCompile(Sender: TPSScript); var i,ii : integer; Fonts : TMFonts; @@ -373,40 +488,14 @@ begin PSScript.AddFunction(ExportedMethods[i].FuncPtr,ExportedMethods[i].FuncDecl); end; -function TMMLPSThread.RequireFile(Sender: TObject; +function TPSThread.RequireFile(Sender: TObject; const OriginFileName: String; var FileName, OutPut: string): Boolean; -var - path: string; - f: TFileStream; begin - if FileExists(FileName) then - Path := FileName - else - Path := IncludePath + Filename; - if not FileExists(Path) then - begin; - psWriteln(Path + ' doesn''t exist'); - Result := false; - Exit; - end; - try - F := TFileStream.Create(Path, fmOpenRead or fmShareDenyWrite); - except - Result := false; - exit; - end; - try - SetLength(Output, f.Size); - f.Read(Output[1], Length(Output)); - finally - f.Free; - end; - Result := True; + result:= LoadFile(FileName,OutPut); end; procedure SIRegister_Mufasa(cl: TPSPascalCompiler); - -begin; +begin with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do begin; RegisterMethod('constructor create'); @@ -445,7 +534,7 @@ begin; end; end; -procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler); +procedure TPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler); begin SIRegister_Std(x); SIRegister_Controls(x); @@ -482,7 +571,7 @@ begin end; end; -procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec; +procedure TPSThread.OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); begin RIRegister_Std(x); @@ -498,7 +587,7 @@ begin se.RegisterFunctionName('SWAP',@swap_,nil,nil); end; -procedure TMMLPSThread.OutputMessages; +procedure TPSThread.OutputMessages; var l: Longint; b: Boolean; @@ -520,7 +609,7 @@ begin end; end; -procedure TMMLPSThread.Execute; +procedure TPSThread.Execute; begin CurrThread := Self; Starttime := lclintf.GetTickCount; @@ -547,68 +636,16 @@ begin end; end; -procedure TMMLPSThread.LoadMethods; +procedure TPSThread.Terminate; begin - ExportedMethods:= GetExportedMethods; + PSScript.Stop; end; -class function TMMLPSThread.GetExportedMethods: TExpMethodArr; -var - c : integer; - CurrSection : string; - - procedure SetCurrSection(str : string); - begin; - CurrSection := Str; - end; - - procedure AddFunction( Ptr : Pointer; DeclStr : String); - begin; - // SetLength(ExportedMethods,c+1); - if c >= 300 then - raise exception.create('PSThread.LoadMethods: Exported more than 300 functions'); - Result[c].FuncDecl:= DeclStr; - Result[c].FuncPtr:= Ptr; - Result[c].Section:= CurrSection; - inc(c); - end; - -begin - c := 0; - CurrSection := 'Other'; - SetLength(Result,300); - - {$i PSInc/psexportedmethods.inc} - - SetLength(Result,c); - -end; - -procedure TMMLPSThread.SetPSScript(Script: string); +procedure TPSThread.SetScript(script: string); begin PSScript.Script.Text:= Script; end; -procedure TMMLPSThread.SetDebug(writelnProc: TWritelnProc); -begin - DebugTo := writelnProc; -end; - -procedure TMMLPSThread.SetDbgImg(DebugImageInfo: TDbgImgInfo); -begin - DebugImg := DebugImageInfo; -end; - -procedure TMMLPSThread.SetPaths(ScriptP, AppP,IncludeP,PluginP,FontP: string); -begin - AppPath:= AppP; - ScriptPath:= ScriptP; - IncludePath:= IncludeP; - PluginPath:= PluginP; - FontPath:= FontP; - -end; - initialization PluginsGlob := TMPlugins.Create; @@ -617,4 +654,3 @@ finalization //Its a nice idea, but it will segfault... the program is closing anyway. end. -