diff --git a/Projects/Simba/Simba.lpi b/Projects/Simba/Simba.lpi index 5ac256e..ea95487 100644 --- a/Projects/Simba/Simba.lpi +++ b/Projects/Simba/Simba.lpi @@ -7,8 +7,8 @@ + - <ResourceType Value="res"/> <UseXPManifest Value="True"/> <Icon Value="0"/> </General> @@ -302,7 +302,7 @@ </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)/;$(ProjPath)../../Units/MMLAddon/PSInc/"/> - <OtherUnitFiles Value="$(ProjPath)/;$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/;$(ProjPath)../../Units/Linux/;$(ProjPath)../../Units/Synapse/;$(LazarusDir)/components/mouseandkeyinput/"/> + <OtherUnitFiles Value="$(ProjPath)/;$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/;$(ProjPath)../../Units/Linux/;$(ProjPath)../../Units/Synapse/;$(LazarusDir)/components/mouseandkeyinput/;$(ProjPath)../../Units/RUTIS/"/> <UnitOutputDirectory Value="$(ProjPath)../../build/$(TargetOS)"/> </SearchPaths> <Parsing> @@ -322,6 +322,9 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> <CustomOptions Value="-dUseCThreads -dM_MEMORY_DEBUG -dFONTDEBUG"/> diff --git a/Projects/Simba/Simba.lpr b/Projects/Simba/Simba.lpr index e772d32..d497819 100644 --- a/Projects/Simba/Simba.lpr +++ b/Projects/Simba/Simba.lpr @@ -41,7 +41,6 @@ uses {$R Simba.res} begin - Application.Title:='Simba'; Application.Initialize; Application.CreateForm(TSimbaForm, SimbaForm); diff --git a/Projects/Simba/framescript.pas b/Projects/Simba/framescript.pas index 79e6ac4..0e1d590 100644 --- a/Projects/Simba/framescript.pas +++ b/Projects/Simba/framescript.pas @@ -606,8 +606,7 @@ begin OwnerSheet := TTabSheet(TheOwner); OwnerPage := TPageControl(OwnerSheet.Owner); - if FileExistsUTF8(SimbaForm.DefScriptPath) then - SynEdit.Lines.LoadFromFile(SimbaForm.DefScriptPath); + SynEdit.Lines.text := SimbaForm.DefaultScript; StartText:= SynEdit.Lines.text; ScriptDefault:= StartText; ScriptName:= 'Untitled'; diff --git a/Projects/Simba/simbaunit.lfm b/Projects/Simba/simbaunit.lfm index b3f248a..ef42744 100644 --- a/Projects/Simba/simbaunit.lfm +++ b/Projects/Simba/simbaunit.lfm @@ -1,7 +1,7 @@ object SimbaForm: TSimbaForm - Left = 674 + Left = 531 Height = 623 - Top = 308 + Top = 290 Width = 660 AllowDropFiles = True Caption = 'THA FUKING Simba' @@ -1243,6 +1243,24 @@ object SimbaForm: TSimbaForm ImageIndex = 7 OnClick = ActionStopExecute end + object MenuDivider7: TMenuItem + Caption = '-' + end + object MenuInterpreters: TMenuItem + Caption = 'Interpreter' + object MenuItemPascalScript: TMenuItem + Action = ActionPascalScript + RadioItem = True + end + object MenuItemRUTIS: TMenuItem + Action = ActionRUTIS + RadioItem = True + end + object MenuItemCPascal: TMenuItem + Action = ActionCPascal + RadioItem = True + end + end end object MenuView: TMenuItem Caption = '&View' @@ -2976,6 +2994,19 @@ object SimbaForm: TSimbaForm OnExecute = ActionExtensionsExecute OnUpdate = ActionExtensionsUpdate end + object ActionPascalScript: TAction + Caption = 'ActionPascalScript' + OnExecute = ActionPascalScriptExecute + end + object ActionRUTIS: TAction + Caption = 'ActionRUTIS' + OnExecute = ActionRUTISExecute + end + object ActionCPascal: TAction + Caption = 'ActionCPascal' + Enabled = False + OnExecute = ActionCPascalExecute + end end object DebugTimer: TTimer OnTimer = ProcessDebugStream diff --git a/Projects/Simba/simbaunit.pas b/Projects/Simba/simbaunit.pas index d932e8d..f55831b 100644 --- a/Projects/Simba/simbaunit.pas +++ b/Projects/Simba/simbaunit.pas @@ -47,6 +47,10 @@ uses const SimbaVersion = 707; + interp_PS = 0; //PascalScript + interp_RT = 1; //RUTIS + interp_CP = 2; //CPascal + type { TMufasaTab } @@ -66,6 +70,9 @@ type { TSimbaForm } TSimbaForm = class(TForm) + ActionCPascal: TAction; + ActionRUTIS: TAction; + ActionPascalScript: TAction; ActionExtensions: TAction; ActionSaveDef: TAction; ActionConsole: TAction; @@ -105,6 +112,11 @@ type MenuFile: TMenuItem; MenuEdit: TMenuItem; MenuHelp: TMenuItem; + MenuDivider7: TMenuItem; + MenuInterpreters: TMenuItem; + MenuItemPascalScript: TMenuItem; + MenuItemCPascal: TMenuItem; + MenuItemRUTIS: TMenuItem; MenuItemOpenPluginsFolder: TMenuItem; MenuItemOpenIncludesFolder: TMenuItem; MenuItemOpenScriptsFolder: TMenuItem; @@ -230,6 +242,7 @@ type procedure ActionCompileScriptExecute(Sender: TObject); procedure ActionConsoleExecute(Sender: TObject); procedure ActionCopyExecute(Sender: TObject); + procedure ActionCPascalExecute(Sender: TObject); procedure ActionCutExecute(Sender: TObject); procedure ActionDeleteExecute(Sender: TObject); procedure ActionExitExecute(Sender: TObject); @@ -241,11 +254,13 @@ type procedure ActionNewTabExecute(Sender: TObject); procedure ActionNormalSizeExecute(Sender: TObject); procedure ActionOpenExecute(Sender: TObject); + procedure ActionPascalScriptExecute(Sender: TObject); procedure ActionPasteExecute(Sender: TObject); procedure ActionPauseExecute(Sender: TObject); procedure ActionRedoExecute(Sender: TObject); procedure ActionReplaceExecute(Sender: TObject); procedure ActionRunExecute(Sender: TObject); + procedure ActionRUTISExecute(Sender: TObject); procedure ActionSaveAllExecute(Sender: TObject); procedure ActionSaveAsExecute(Sender: TObject); procedure ActionSaveDefExecute(Sender: TObject); @@ -359,10 +374,12 @@ type OpenFileData : TOpenFileData; WriteFileData : TWriteFileData; ScriptStartData : TScriptStartData; + procedure UpdateInterpreter; procedure HandleConnectionData; procedure HandleOpenFileData; procedure HandleWriteFileData; procedure HandleScriptStartData; + function GetInterpreter: Integer; function GetDefScriptPath: string; function GetScriptPath : string; function GetExtPath: string; @@ -378,6 +395,7 @@ type procedure SetExtPath(const AValue: string); procedure SetFontPath(const AValue: String); procedure SetIncludePath(const AValue: String); + procedure SetInterpreter(const AValue: Integer); procedure SetPluginPath(const AValue: string); procedure SetScriptPath(const AValue: string); procedure SetShowParamHintAuto(const AValue: boolean); @@ -441,6 +459,7 @@ type procedure InitalizeTMThread(var Thread : TMThread); procedure HandleParameters; procedure OnSaveScript(const Filename : string); + property Interpreter : Integer read GetInterpreter write SetInterpreter; property ShowParamHintAuto : boolean read GetShowParamHintAuto write SetShowParamHintAuto; property ShowCodeCompletionAuto: Boolean read GetShowCodeCompletionAuto write SetShowCodeCompletionAuto; property IncludePath : String read GetIncludePath write SetIncludePath; @@ -450,6 +469,7 @@ type property ScriptDir : string read GetScriptPath write SetScriptPath; property DefScriptPath : string read GetDefScriptPath write SetDefScriptPath; property CurrHighlighter : TSynCustomHighlighter read GetHighlighter; + function DefaultScript : string; end; procedure ClearDebug; @@ -592,6 +612,18 @@ begin end; end; +procedure TSimbaForm.UpdateInterpreter; +begin + ActionPascalScript.Checked:= false; + ActionRUTIS.Checked:= false; + ActionCPascal.Checked:= false; + case Interpreter of + interp_PS: ActionPascalScript.Checked:= True; + interp_CP: ActionCPascal.Checked:= True; + interp_RT: ActionRUTIS.Checked:= true; + end; +end; + procedure TSimbaForm.HandleConnectionData; var Args : TVariantArray; @@ -609,6 +641,16 @@ begin end; end; +function TSimbaForm.GetInterpreter: Integer; +begin + result := StrToIntDef(LoadSettingDef('Settings/Interpreter/Type','0'),0); + if (result < 0) or (result > 2) then + begin + SetInterpreter(0); + result := 0; + end; +end; + function TSimbaForm.GetDefScriptPath: string; begin result :=LoadSettingDef('Settings/SourceEditor/DefScriptPath', ExpandFileName(MainDir+DS+'default.simba')); @@ -1172,7 +1214,7 @@ var begin CreateSetting('Settings/Updater/CheckForUpdates','True'); CreateSetting('Settings/Updater/CheckEveryXMinutes','30'); - CreateSetting('Settings/Interpreter/UseCPascal', 'False'); + CreateSetting('Settings/Interpreter/Type', '0'); CreateSetting('Settings/Fonts/LoadOnStartUp', 'True'); CreateSetting('Settings/Fonts/Version','-1'); CreateSetting('Settings/Tabs/OpenNextOnClose','False'); @@ -1275,6 +1317,7 @@ begin MTrayIcon.Hide; writeln('Hiding tray.'); end; + UpdateInterpreter; self.EndFormUpdate; end; @@ -1419,14 +1462,14 @@ begin AppPath:= MainDir + DS; CurrScript.ScriptErrorLine:= -1; CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; - UseCPascal := LoadSettingDef('Settings/Interpreter/UseCPascal', 'False'); try - if lowercase(UseCPascal) = 'true' then - Thread := TCPThread.Create(True,@CurrentSyncInfo,PluginPath) - else - Thread := TPSThread.Create(True,@CurrentSyncInfo,PluginPath); + case Interpreter of + interp_PS : Thread := TPSThread.Create(true,@CurrentSyncInfo,PluginPath); + interp_RT : Thread := TRTThread.Create(true,@CurrentSyncInfo,PluginPath); + interp_CP : Thread := TCPThread.Create(true,@CurrentSyncInfo,PluginPath); + end; except - mDebugLn('Failed to initialise the library!'); + mDebugLn('Failed to initialise the interpreter'); Exit; end; {$IFNDEF TERMINALWRITELN} @@ -1535,6 +1578,26 @@ begin end; end; +function TSimbaForm.DefaultScript: string; +var + x : TStringList; +begin + result := ''; + case Interpreter of + interp_PS : begin + if FileExistsUTF8(SimbaForm.DefScriptPath) then + begin + x := TStringList.Create; + x.LoadFromFile(SimbaForm.DefScriptPath); + result := x.Text; + end else + result := 'program new;'+LineEnding + 'begin'+LineEnding+'end.' + LineEnding; + end; + interp_RT : result := 'program untitled;' + LineEnding + lineEnding + 'interface' + LineEnding + LineEnding + + 'implementation' + LineEnding + LineEnding + 'begin' + LineEnding + 'end.' + LineEnding; + end; +end; + procedure TSimbaForm.ActionTabLastExecute(Sender: TObject); var @@ -1580,6 +1643,11 @@ begin Memo1.CopyToClipboard; end; +procedure TSimbaForm.ActionCPascalExecute(Sender: TObject); +begin + Interpreter:= interp_CP; +end; + procedure TSimbaForm.ActionCutExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then @@ -1672,6 +1740,11 @@ begin Self.OpenScript; end; +procedure TSimbaForm.ActionPascalScriptExecute(Sender: TObject); +begin + Interpreter:= interp_PS; +end; + procedure TSimbaForm.ActionPasteExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then @@ -1710,6 +1783,11 @@ begin Self.RunScript; end; +procedure TSimbaForm.ActionRUTISExecute(Sender: TObject); +begin + Interpreter:= interp_RT; +end; + procedure TSimbaForm.ActionSaveAllExecute(Sender: TObject); var i : integer; @@ -2689,6 +2767,21 @@ begin SetSetting('Settings/Includes/Path',AValue,true); end; +procedure TSimbaForm.SetInterpreter(const AValue: Integer); +var + UpdateCurrScript: Boolean; +begin + UpdateCurrScript := false; + 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); + UpdateInterpreter; + if UpdateCurrScript then + CurrScript.SynEdit.Lines.text := DefaultScript; +end; + procedure TSimbaForm.SetPluginPath(const AValue: string); begin SetSetting('Settings/Plugins/Path',AValue,true); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 4fd685a..10a385b 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -33,7 +33,7 @@ uses Classes, SysUtils, client, uPSComponent,uPSCompiler, uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes,MufasaBase, web, bitmaps, plugins, libloader, dynlibs,internets,scriptproperties, - settings,settingssandbox; + settings,settingssandbox, Rutis_Engine,Rutis_Defs; const m_Status = 0; //Data = PChar to new status @@ -189,6 +189,22 @@ type procedure AddMethod(meth: TExpMethod); override; end; + { TRTThread } + + TRTThread = class(TMThread) + private + procedure RTOnWrite(s : String); + procedure RTOnError(s : String; ErrorType : TRutisErrorType); + public + RUTIS : TRutisEngine; + 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 : TMThread; var @@ -963,6 +979,67 @@ begin raise Exception.Create('Stopping Interpreter not yet implemented'); end; +{ TRTThread } + +procedure TRTThread.RTOnWrite(s: String); +begin + psWriteln(s); +end; + +procedure TRTThread.RTOnError(s: String; ErrorType: TRutisErrorType); +begin + psWriteln(s); +end; + +constructor TRTThread.Create(CreateSuspended: Boolean; TheSyncInfo: PSyncInfo; + plugin_dir: string); +begin + inherited Create(CreateSuspended, TheSyncInfo, plugin_dir); + RUTIS := TRutisEngine.Create; + RUTIS.OnWrite:= @RTOnWrite; + RUTIS.OnError:= @RTOnError; + RUTIS.OptProcessTimer:= false; +end; + +destructor TRTThread.Destroy; +begin + RUTIS.Free; + inherited Destroy; +end; + +procedure TRTThread.SetScript(script: string); +begin + RUTIS.ScriptCode.Text:= Script; +end; + +procedure TRTThread.Execute; +begin + CurrThread := self; + Starttime := lclintf.GetTickCount; + try + RUTIS.Compile; + if not RUTIS.CompilerError then + begin + psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - Starttime) + ' ms.'); + if CompileOnly then + exit; + RUTIS.Run; + end else + begin + CurrThread.HandleError(RUTIS.Error.ELine+1,RUTIS.Error.EChrPos,-1,RUTIS.Error.Message,errCompile,''); + psWriteln('Compiling failed.'); + end; + except + on E : Exception do + psWriteln('Exception in Script: ' + e.message); + end; +end; + +procedure TRTThread.Terminate; +begin + RUTIS.Stop; +end; + initialization PluginsGlob := TMPlugins.Create; libcpascal:= 0;