diff --git a/Extensions/extension.sex b/Extensions/extension.sex new file mode 100644 index 0000000..ce79e60 --- /dev/null +++ b/Extensions/extension.sex @@ -0,0 +1,15 @@ +program ExtUpdater; +{$I ..\Extensions\Updater.sei} + +procedure Init; +var + EXT: integer; +begin + Settings.GetKeyValueDef('Extensions_Visible', 'false'); //Default Menu to be hidden =) + AddUpdater('Extensions', 'http://wizzup.org/static/srl/exten.tar.bz2', + 'http://wizzup.org/static/srl/exten_version', ScriptPath + {$IFDEF WINDOWS}'\' {$ELSE}'/'{$ENDIF}, True, True, EXT); +end; + +function GetName: string; begin Result := 'Extensions Updater'; end; +function GetVersion: string; begin Result := '0.1'; end; +begin end. diff --git a/Install/windows/Setup.iss b/Install/windows/Setup.iss index 3318fa5..32173a0 100644 --- a/Install/windows/Setup.iss +++ b/Install/windows/Setup.iss @@ -30,11 +30,12 @@ Name: "{app}\Extensions" Name: "{app}\Includes" Name: "{app}\Plugins" Name: "{app}\Scripts" -Name: "{app}\Scripts\Tests" +; Name: "{app}\Scripts\Tests" [Files] Source: "C:\Simba\Simba.exe"; DestDir: "{app}"; Flags: ignoreversion Source: "C:\Simba\Extensions\srl.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion +Source: "C:\Simba\Extensions\extension.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\msi.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\associate.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\dtm_editor.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion diff --git a/Tests/PS/bmpbench.simba b/Tests/PS/bmpbench.simba new file mode 100644 index 0000000..dc9acea --- /dev/null +++ b/Tests/PS/bmpbench.simba @@ -0,0 +1,34 @@ +program new; +//http://farm4.static.flickr.com/3067/2612399892_7df428d482.jpg +{Make the above bitmap your target} +var + Bmp : integer; + x,y : integer; + w,h : integer; + t, i, c: integer; +begin + Bmp := createBitmap(15, 10); + FastDrawClear(bmp, clRed); + GetClientDimensions(w,h); + writeln(w); + writeln(h); + + for c := 0 to 2 do + begin + writeln('cts: ' + inttostr(c)); + setcolortolerancespeed(c); + + t:=getsystemtime; + for i := 0 to 100 do + findBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,10); + writeln((getsystemtime-t) / 100.0); + if findBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,200) then + writeln('found'); + end; + + {if FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,300) then + begin + writeln('found'); + MoveMouse(x,y); + end;} +end. diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 2896de6..5e006db 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -188,7 +188,8 @@ type procedure OnCompile(Sender: TPSScript); function RequireFile(Sender: TObject; const OriginFileName: String; var FileName, OutPut: string): Boolean; - function FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; + function FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean; + function OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean; procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler); procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); @@ -447,7 +448,9 @@ begin Exit; end; filename := path;//Yeah! - Includes.Add(path); + + if Includes.IndexOf(path) = -1 then + Includes.Add(path); try f:= TFileStream.Create(UTF8ToSys(Path), fmOpenRead); @@ -637,6 +640,7 @@ begin PSScript.UsePreProcessor:= True; PSScript.CompilerOptions := PSScript.CompilerOptions + [icBooleanShortCircuit]; PSScript.OnNeedFile := @RequireFile; + PSScript.OnIncludingFile := @OnIncludingFile; PSScript.OnFileAlreadyIncluded := @FileAlreadyIncluded; PSScript.OnProcessDirective:=@OnProcessDirective; PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknownDirective; @@ -758,26 +762,59 @@ begin '{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}'; end; -function TPSThread.FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; +function TPSThread.FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean; var path: string; i: integer; begin - path := FindFile(Filename,[ScriptPath,IncludePath]); + path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]); + if path = '' then + begin + Result := True; + Exit; + end; + path := ExpandFileNameUTF8(path); + if (path <> '') then - if Includes.Find(path,i) then + if Includes.IndexOf(path) <> -1 then begin {$IFDEF SIMBA_VERBOSE} - psWriteln('Include_Once file already included:' + Path); + writeln('Include_Once file already included:' + Path); {$ENDIF} Result := True; Exit; end; + {$IFDEF SIMBA_VERBOSE} + writeln('OnFileAlreadyIncluded, Adding: ' + path); + {$ENDIF} Includes.Add(path); Result := False; end; +function TPSThread.OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean; +var + path: string; +begin + path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]); + if path = '' then + begin + Result := True; + Exit; + end; + path := ExpandFileNameUTF8(path); + + if Includes.IndexOf(path) = -1 then + begin + {$IFDEF SIMBA_VERBOSE} + writeln('OnIncludingFile, Adding: ' + path); + {$ENDIF} + Includes.Add(path); + end; + + Result := True; // Not used +end; + procedure SIRegister_Mufasa(cl: TPSPascalCompiler); begin SIRegister_MML(cl); diff --git a/Units/MMLCore/files.pas b/Units/MMLCore/files.pas index dfcc473..18d2aaf 100644 --- a/Units/MMLCore/files.pas +++ b/Units/MMLCore/files.pas @@ -128,6 +128,7 @@ begin; exit; end; end; + result := ''; end; constructor TMFiles.Create(Owner : TObject); diff --git a/Units/MMLCore/os_linux.pas b/Units/MMLCore/os_linux.pas index 94bdeed..54dce59 100644 --- a/Units/MMLCore/os_linux.pas +++ b/Units/MMLCore/os_linux.pas @@ -20,15 +20,21 @@ Linux OS specific implementation for Mufasa Macro Library } -{$mode objfpc}{$H+} +{$mode objfpc}{$H+} unit os_linux; +{ + TODO's: + - Allow selecting a different X display + - Fix keyboard layout / SendString +} + interface uses Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest, syncobjs, mufasabase; - + type TNativeWindow = x.TWindow; @@ -43,7 +49,7 @@ interface TWindow = class(TWindow_Abstract) public - constructor Create(display: PDisplay; screennum: integer; window: x.TWindow); + constructor Create(display: PDisplay; screennum: integer; window: x.TWindow); destructor Destroy; override; procedure GetTargetDimensions(out w, h: integer); override; procedure GetTargetPosition(out left, top: integer); override; @@ -89,7 +95,7 @@ interface { X Error Handler } oldXHandler: TXErrorHandler; end; - + TIOManager = class(TIOManager_Abstract) public constructor Create; @@ -109,7 +115,7 @@ interface end; function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl; - + implementation uses GraphType, interfacebase, lcltype; @@ -126,7 +132,7 @@ implementation { This is extremely hacky, but also very useful. We have to install a X error handler, because otherwise X - will terminate out entire app on error. + will terminate our entire app on error. Since we want the right thread to recieve the right error, we have to fiddle a bit with threadvars, mutexes / semaphores. @@ -207,8 +213,8 @@ implementation end; { See if the semaphores / CS are initialised } - constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow); - begin + constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow); + begin inherited Create; self.display:= display; self.screennum:= screennum; @@ -227,8 +233,8 @@ implementation finally ErrorCS.Leave; end; - end; - + end; + destructor TWindow.Destroy; var erh: TXErrorHandler; @@ -304,8 +310,8 @@ implementation if ReceivedError then raise Exception.Create('Error: ActivateClient: ' + GetError); end; - - function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData; + + function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData; var w,h: integer; begin @@ -334,8 +340,8 @@ implementation dirty:= true; //XSetErrorHandler(Old_Handler); end; - - procedure TWindow.FreeReturnData; + + procedure TWindow.FreeReturnData; begin if dirty then begin @@ -413,40 +419,41 @@ implementation result := xmask and ButtonP > 0; end; -procedure TWindow.SendString(str: string); -var - I, L: Integer; - K: Byte; - HoldShift: Boolean; -begin - HoldShift := False; - L := Length(str); - for I := 1 to L do + { TODO: Check if this supports multiple keyboard layouts, probably not } + procedure TWindow.SendString(str: string); + var + I, L: Integer; + K: Byte; + HoldShift: Boolean; begin - if (((str[I] >= 'A') and (str[I] <= 'Z')) or - ((str[I] >= '!') and (str[I] <= '&')) or - ((str[I] >= '(') and (str[I] <= '+')) or - (str[I] = ':') or - ((str[I] >= '<') and (str[I] <= '@')) or - ((str[I] >= '^') and (str[I] <= '_')) or - ((str[I] >= '{') and (str[I] <= '~'))) then + HoldShift := False; + L := Length(str); + for I := 1 to L do begin - HoldKey(VK_SHIFT); - HoldShift := True; - end; - - K := GetKeyCode(str[I]); - HoldKey(K); - Sleep(20); - ReleaseKey(K); - - if (HoldShift) then - begin - HoldShift := False; - ReleaseKey(VK_SHIFT); + if (((str[I] >= 'A') and (str[I] <= 'Z')) or + ((str[I] >= '!') and (str[I] <= '&')) or + ((str[I] >= '(') and (str[I] <= '+')) or + (str[I] = ':') or + ((str[I] >= '<') and (str[I] <= '@')) or + ((str[I] >= '^') and (str[I] <= '_')) or + ((str[I] >= '{') and (str[I] <= '~'))) then + begin + HoldKey(VK_SHIFT); + HoldShift := True; + end; + + K := GetKeyCode(str[I]); + HoldKey(K); + Sleep(20); + ReleaseKey(K); + + if (HoldShift) then + begin + HoldShift := False; + ReleaseKey(VK_SHIFT); + end; end; end; -end; procedure TWindow.HoldKey(key: integer); begin @@ -474,7 +481,7 @@ end; Raise Exception.CreateFMT('GetSimpleKeyCode - char (%s) is not in A..z',[c]); end end; - + { ***implementation*** IOManager } constructor TIOManager.Create; @@ -499,17 +506,17 @@ end; { Get the Desktop Window } desktop:= RootWindow(display,screennum) end; - - procedure TIOManager.NativeFree; + + procedure TIOManager.NativeFree; begin XCloseDisplay(display); end; - + procedure TIOManager.SetDesktop; begin SetBothTargets(TWindow.Create(display, screennum, desktop)); end; - + function TIOManager.SetTarget(target: x.TWindow): integer; begin result := SetBothTargets(TWindow.Create(display, screennum, target)) diff --git a/Units/PascalScript/uPSComponent.pas b/Units/PascalScript/uPSComponent.pas index 78166a6..9aad121 100644 --- a/Units/PascalScript/uPSComponent.pas +++ b/Units/PascalScript/uPSComponent.pas @@ -94,7 +94,8 @@ type TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object; { Added by Wizzup } - TPSOnFileAlreadyIncluded = function (Sender: TObject; FileName: tbtstring): Boolean of object; + TPSOnFileAlreadyIncluded = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object; + TPSOnIncludingFile = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object; { Wizzup out } TPSOnProcessDirective = procedure ( @@ -127,6 +128,7 @@ type FOnNeedFile: TPSOnNeedFile; { Added by Wizzup } FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded; + FOnIncludingFile: TPSOnIncludingFile; { Wizzup out } FUsePreProcessor: Boolean; FDefines: TStrings; @@ -161,7 +163,8 @@ type //--jgv new function DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual; { Added by Wizzup } - function DoOnFileAlreadyIncluded (Sender: TObject; FileName: tbtstring): Boolean; virtual; + function DoOnFileAlreadyIncluded (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual; + function DoOnIncludingFile (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual; { Wizzup out } function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed procedure DoOnCompImport; virtual; @@ -300,6 +303,7 @@ type { Added by Wizzup } property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded; + property OnIncludingFile: TPSOnIncludingFile read FOnIncludingFile write FOnIncludingFile; { Wizzup out } property Defines: TStrings read FDefines write SetDefines; @@ -553,9 +557,14 @@ begin end; { Added by Wizzup } -function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring): Boolean; +function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean; begin - Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename); + Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, OrgFileName, Filename); +end; + +function CEOnIncludingFile(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean; +begin + Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, OrgFileName, Filename); end; { Wizzup out } @@ -675,6 +684,7 @@ begin { Added by Wizzup } FPP.OnFileAlreadyIncluded:= CEOnFileAlreadyIncluded; + FPP.OnIncludingFile:= CEOnIncludingFile; { Wizzup out } FDefines := TStringList.Create; @@ -1081,10 +1091,19 @@ end; { Added by Wizzup } function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject; - FileName: tbtstring): Boolean; + OrgFileName, FileName: tbtstring): Boolean; begin If Assigned (OnFileAlreadyIncluded) then - Result := OnFileAlreadyIncluded(Sender, FileName) + Result := OnFileAlreadyIncluded(Sender, OrgFileName, FileName) + else + Result := False; +end; + +function TPSScript.DoOnIncludingFile(Sender: TObject; + OrgFileName, FileName: tbtstring): Boolean; +begin + If Assigned (OnIncludingFile) then + Result := OnIncludingFile(Sender, OrgFileName, FileName) else Result := False; end; diff --git a/Units/PascalScript/uPSPreProcessor.pas b/Units/PascalScript/uPSPreProcessor.pas index c71e912..0dc4438 100644 --- a/Units/PascalScript/uPSPreProcessor.pas +++ b/Units/PascalScript/uPSPreProcessor.pas @@ -16,7 +16,8 @@ type TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean; { Added by Wizzup } - TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean; + TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean; + TPSOnIncludingFile = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean; { Wizzup out } TPSOnProcessDirective = procedure ( @@ -99,6 +100,7 @@ type FOnNeedFile: TPSOnNeedFile; { Added by Wizzup } FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded; + FOnIncludingFile: TPSOnIncludingFile; { Wizzup out } FAddedPosition: Cardinal; FDefineState: TPSDefineStates; @@ -120,6 +122,7 @@ type { Added by Wizzup } property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded; + property OnIncludingFile: TPSOnIncludingFile read FOnIncludingFile write FOnIncludingFile; { Wizzup out } property Defines: TStringList read FDefines write FDefines; @@ -633,6 +636,8 @@ begin begin if FDefineState.DoWrite then begin + if assigned(@OnIncludingFile) then + OnIncludingFile(self , Filename, s); FAddedPosition := 0; IntPreProcess(Level +1, FileName, s, Dest); FCurrentLineInfo.Current := current; @@ -646,7 +651,7 @@ begin raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName]) else begin - if not OnFileAlreadyIncluded(Self, FileName) then + if not OnFileAlreadyIncluded(Self, FileName, s) then begin FAddedPosition := 0; IntPreProcess(Level +1, FileName, s, Dest); diff --git a/Units/lape b/Units/lape index 940053e..b24c52b 160000 --- a/Units/lape +++ b/Units/lape @@ -1 +1 @@ -Subproject commit 940053e16d79c3d76b6b70d6a1bf56507ad0e627 +Subproject commit b24c52b9748c6f9f3e91a7a86f727022bf2fd6ce