moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-30 12:52:16 -05:00
Code Issues Releases Wiki Activity

Merge branch 'master' into lape-integration

Browse Source
This commit is contained in:
Merlijn Wajer 2011-07-31 18:11:58 +02:00
commit 0701e911d1
9 changed files with 184 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Extensions/extension.sex Normal file
View File

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

3
Install/windows/Setup.iss
View File

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

34
Tests/PS/bmpbench.simba Normal file
View File

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

49
Units/MMLAddon/mmlpsthread.pas
View File

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

1
Units/MMLCore/files.pas
View File

@ -128,6 +128,7 @@ begin;
exit;
end;
end;
result := '';
end;
constructor TMFiles.Create(Owner : TObject);

105
Units/MMLCore/os_linux.pas
View File

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

31
Units/PascalScript/uPSComponent.pas
View File

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

9
Units/PascalScript/uPSPreProcessor.pas
View File

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

2
Units/lape

@ -1 +1 @@
Subproject commit 940053e16d79c3d76b6b70d6a1bf56507ad0e627
Subproject commit b24c52b9748c6f9f3e91a7a86f727022bf2fd6ce