moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-10 19:35:10 -05:00
Code Issues Releases Wiki Activity

Merge branch 'master' of ssh://villavu.com:54367/simba

Browse Source
This commit is contained in:
Merlijn Wajer 2010-06-15 19:15:59 +02:00
commit b22e4774d7
6 changed files with 142 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
Extensions/dtm_editor.sex
View File

@ -1,5 +1,6 @@
program DTMEditor_Extension;
{$i mml.simba}
const
Version = '0.5';
ZoomPixels = 3; //Should be an odd number (1, 3, 5, 7, ..)
@ -28,7 +29,6 @@ var
Zoom: Single;
p: TSDTMPointDefArray;
curP: Integer;
MarkCol: Integer;
PaintDTM, BufferChanged: Boolean;
@ -243,7 +243,7 @@ begin
begin
for i := 1 to High(p) do
Points := CombineTPA(Points, GetLine(Point(Max(Min(p[0].x, bmpBuffer.Width - 1), 0), Max(Min(p[0].y, bmpBuffer.Height - 1), 0)), Point(Max(Min(p[i].x, bmpBuffer.Width - 1), 0), Max(Min(p[i].y, bmpBuffer.Height - 1), 0))));
//bmpBuffer.DrawTPA(Points, MarkCol);
bmpBuffer.DrawTPA(Points, MarkCol);
DrawDots(True);
BufferChanged := True;
@ -405,11 +405,8 @@ procedure LoadClientBitmap;
var
w, h: Integer;
begin
bmp.CopyClientToBitmap(False, 0, 0, 0, 0, 1620, 1280);
//GetClientDimensions(w, h);
//bmp.SetSize(w, h);
//CopyClientToBitmap(bmp.Index, 0, 0, w - 1, h - 1);
GetClientDimensions(w, h);
bmp.CopyClientToBitmap(client.IOManager,true,0,0,0,0,w-1,h-1);
ResetBuffer;
UpdateBitmap(True, False);
end;
@ -560,7 +557,7 @@ end;
procedure mnuClientDesktop(Sender: TObject);
begin
//SetDesktopAsClient;
SetDesktopAsClient;
LoadClientBitmap;
end;
@ -604,7 +601,7 @@ begin
BufferChanged := True;
PaintDTM := False;
{h := GetImageTarget;
h := GetImageTarget;
if (bmpOverlay = nil) then
bmpOverlay := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1);
SetTargetBitmap(bmpBuffer.Index);
@ -612,7 +609,7 @@ begin
if FindColorsTolerance(Points, getColour, 0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1, getTolerance) then
bmpOverlay.DrawTPA(Points, MarkCol);
SetImageTarget(h);}
SetImageTarget(h);
UpdateBitmap(True, False);
end;
@ -626,11 +623,11 @@ begin
if (Length(p) > 0) then
begin
{dtm := AddSDTM(toSDTM);
dtm := Client.MDTMs.AddSDTM(toSDTM);
h := GetImageTarget;
if (bmpOverlay = nil) then
bmpOverlay := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1);
SetTargetBitmap(bmpBuffer.Index);
SetTargetBitmap(bmpBuffer);
if FindDTMs(dtm, p1, 0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1) then
begin
@ -645,7 +642,7 @@ begin
end;
SetImageTarget(h);
FreeDTM(dtm);}
FreeDTM(dtm);
end;
UpdateBitmap(True, False);
end;
@ -671,7 +668,7 @@ var
mdtm: TMDTM;
sdtm: TSDTM;
begin
{if InputQuery('DTM From String', 'Enter DTM string:', s) and (s <> '') then
if InputQuery('DTM From String', 'Enter DTM string:', s) and (s <> '') then
begin
mnuNew(nil);
@ -689,7 +686,7 @@ begin
mdtm.Free;
UpdateBitmap(True, False);
end;}
end;
end;
procedure mnuPrintDTM(Sender: TObject);
@ -698,13 +695,11 @@ var
begin
if (Length(p) > 0) then
begin
{mdtm := SDTMToMDTM(toSDTM);
AddDTM(mdtm);
mdtm := SDTMToMDTM(toSDTM);
WriteLn('');
WriteLn(mdtm.ToString);
WriteLn('');
mdtm.Free;}
mdtm.Free;
end;
end;

67
Includes/mml.simba Normal file
View File

@ -0,0 +1,67 @@
procedure GetClientDimensions(var w,h : integer);
begin
Client.IOManager.GetDimensions(w, h);
end;
procedure SetDesktopAsClient;
begin
Client.IOManager.SetDesktop;
end;
function SetTargetBitmap(bitmap: TMufasaBitmap): integer;
begin;
result:= Client.IOManager.SetTargetBitmap(Bitmap);
end;
procedure SetImageTarget(idx: integer);
begin
Client.IOManager.SetImageTarget(idx);
end;
function GetImageTarget: integer;
begin
Client.IOManager.GetImageTarget(result);
end;
function Freeze: boolean;
begin
Client.IOManager.SetFrozen(true);
result := true; //dunno what the result is supposed to mean
end;
function Unfreeze: boolean;
begin
Client.IOManager.SetFrozen(false);
result := true; //dunno what the result is supposed to mean
end;
function FindDTMs(DTM: Integer; var p: TPointArray; xs, ys, xe, ye: Integer): Boolean;
begin
with Client do
result := MFinder.FindDTMs(MDTMs.GetDTM(DTM), p, xs, ys, xe, ye,0);
end;
procedure FreeDTM(DTM: Integer);
begin
Client.MDTMs.FreeDTM(DTM);
end;
function DTMFromString(const DTMString: String): Integer;
begin
Result := Client.MDTMs.StringToDTM(DTMString);
end;
function AddDTM(const d: TMDTM): Integer;
begin
Result := Client.MDTMs.AddMDTM(d);
end;
function GetDTM(const index : integer) : TMDTM;
begin
result := Client.MDTMs.GetDTM(index);
end;
function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;
begin;
result := Client.MFinder.FindColorsTolerance(points,color,xs,ys,xe,ye,tolerance);
end;

74
Projects/Simba/psextension.pas
View File

@ -30,6 +30,7 @@ type
procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
procedure RegisterMyMethods(x: TPSScript);
procedure OnPSExecute(Sender: TPSScript);
function OnNeedFile(Sender: TObject;const OrginFileName: string; var FilePath, Output: string): Boolean;
procedure SetEnabled(bool : boolean);override;
public
constructor Create(FileStr: String; StartDisabled : boolean = false);
@ -165,35 +166,13 @@ end;
{$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc}
procedure TSimbaPSExtension.RegisterMyMethods(x: TPSScript);
procedure SetCurrSection(s: string);
begin
end;
var
AppPath, ScriptPath: string;
i: Integer;
begin
AppPath := MainDir + DirectorySeparator;
ScriptPath := ExtractFileDir(Filename);
with SimbaForm, x do
begin
with Comp do
begin
{$I ../../Units/MMLAddon/PSInc/pscompile.inc}
AddTypes('TStringArray','Array of String');
AddConstantN('ExtPath','string').SetString(ExtPath);
AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmation, mtCustom )');
AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
for i := 0 to high(VirtualKeys) do
AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key);
end;
{$i ../../Units/MMLAddon/PSInc/psexportedmethods.inc}
AddFunction(@ext_SDTMToMDTM,'function SDTMToMDTM(Const DTM: TSDTM): TMDTM;');
AddFunction(@ext_GetPage,'function GetPage(const url : string) : string');
AddFunction(@ext_DecompressBZip2,'function DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;');
@ -248,6 +227,9 @@ begin
end;
procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
var
AppPath, ScriptPath: string;
i: Integer;
begin
SIRegister_Std(x);
SIRegister_Controls(x);
@ -259,6 +241,20 @@ begin
SIRegister_Menus(x);
SIRegister_ComCtrls(x);
SIRegister_Dialogs(x);
AppPath := MainDir + DirectorySeparator;
ScriptPath := ExtractFileDir(Filename);
with SimbaForm,x do
begin
{$I ../../Units/MMLAddon/PSInc/pscompile.inc}
AddTypes('TStringArray','Array of String');
AddConstantN('ExtPath','string').SetString(ExtPath);
AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmation, mtCustom )');
AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
for i := 0 to high(VirtualKeys) do
AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key);
end;
SIRegister_MML(x);
RegisterDll_Compiletime(x);
@ -303,10 +299,10 @@ begin
RIRegister_Dialogs(x);
RegisterDLLRuntime(se);
RIRegister_MML(x);
with x.FindClass('TMufasaBitmap') do
{ with x.FindClass('TMufasaBitmap') do
begin
RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap');
end;
end;}
se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil);
se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil);
@ -322,6 +318,34 @@ begin
inherited;
end;
function TSimbaPSExtension.OnNeedFile(Sender: TObject;
const OrginFileName: string; var FilePath, Output: string): Boolean;
var
path: string;
f: TFileStream;
begin
with SimbaForm do
path := FindFile(FilePath,[includepath, ExtractFileDir(Filename),ExtractFileDir(OrginFileName)]);
if path = '' then
begin
psWriteln(Path + ' doesn''t exist');
Result := false;
Exit;
end;
FilePath := path;//Yeah!
try
f:= TFileStream.Create(UTF8ToSys(Path), fmOpenRead);
SetLength(Output, f.Size);
f.Read(Output[1], Length(Output));
result:= true;
f.free;
except
Result := false;
psWriteln('TSimbaPSExtension.OnNeedFile');
end;
end;
procedure TSimbaPSExtension.StartExtension;
begin
if assigned(PSInstance) then
@ -339,6 +363,8 @@ begin
PSInstance.OnExecImport:=@RegisterPSRComponents;
PSInstance.OnCompile:=@RegisterMyMethods;
PSInstance.OnExecute:=@OnPSExecute;
PSInstance.OnNeedFile:=@OnNeedFile;
PSInstance.UsePreProcessor:= True;
formWritelnEx(Format('Loading extension %s', [FileName]));
try

2
Units/MMLAddon/PSInc/Wrappers/internets.inc
View File

@ -54,5 +54,5 @@ end;
procedure ps_SetProxy(Client : Integer; pHost, pPort : String); extdecl;
begin
CurrThread.MInternet.GetHTTPClient(client).SetProxy(pHost, pPort);
CurrThread.MInternet.GetHTTPClient(client).SetProxy(pHost, pPort);
end;

6
Units/MMLAddon/PSInc/uPSC_mml.pas
View File

@ -270,7 +270,9 @@ procedure SIRegister_TWindow(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TWindow_Abstract'),'TWindow') do
begin
{$ifdef mswindows}
RegisterMethod('Constructor Create( target : Hwnd)');
{$endif}
RegisterMethod('Function GetNativeWindow : TNativeWindow');
end;
end;
@ -284,8 +286,8 @@ begin
RegisterMethod('Function ReceivedError : Boolean');
RegisterMethod('Procedure ResetError');
RegisterMethod('Procedure SetDesktop');
RegisterMethod('Function SetTargetArr( ArrPtr : Integer; Size : TPoint) : integer;');
RegisterMethod('Function SetTargetBmp( bmp : TMufasaBitmap) : integer;');
RegisterMethod('Function SetTargetArray( ArrPtr : Integer; Size : TPoint) : integer;');
RegisterMethod('Function SetTargetBitmap( bmp : TMufasaBitmap) : integer;');
RegisterMethod('Function TargetValid : Boolean');
RegisterMethod('Procedure BitmapDestroyed( Bitmap : TMufasaBitmap)');
RegisterMethod('Function GetColor( x, y : integer) : TColor');

8
Units/MMLAddon/PSInc/uPSR_mml.pas
View File

@ -94,7 +94,9 @@ Function TIOManager_AbstractGetKeyMouseTarget_P(Self: TIOManager_Abstract) : TTa
Function TIOManager_AbstractGetImageTarget_P(Self: TIOManager_Abstract) : TTarget;Begin Result := Self.GetImageTarget; END;
Function TIOManager_AbstractSetTargetBmp_P(Self: TIOManager_Abstract; bmp : TMufasaBitmap) : integer;Begin Result := Self.SetTarget(bmp); END;
Function TIOManager_AbstractSetTargetArr_P(Self: TIOManager_Abstract; ArrPtr : Integer; Size : TPoint) : integer;Begin Result := Self.SetTarget(PRGB32(ArrPtr), Size); END;
{$ifdef MSWindows}
function TWindowCreate(handle : hwnd) : TWindow; begin result := TWindow.Create(handle); end;
{$endif}
function TIOManagerCreate(plugin_dir : string) : TIOManager; begin result := TIOManager.Create(plugin_dir); end;
function TIOManager_AbstractCreate(plugin_dir : string) : TIOManager_Abstract; begin result := TIOManager_Abstract.Create(plugin_dir); end;
Function TIOManagerSetTarget_P(Self: TIOManager; target : TNativeWindow) : integer;Begin Result := Self.SetTarget(target); END;
@ -357,7 +359,9 @@ procedure RIRegister_TWindow(CL: TPSRuntimeClassImporter);
begin
with CL.Add(TWindow) do
begin
{$ifdef MSWindows}
RegisterConstructor(@TWindowCreate, 'Create');
{$endif}
RegisterMethod(@TWindow.GetNativeWindow, 'GetNativeWindow');
end;
end;
@ -371,8 +375,8 @@ begin
RegisterMethod(@TIOManager_Abstract.ReceivedError, 'ReceivedError');
RegisterMethod(@TIOManager_Abstract.ResetError, 'ResetError');
// RegisterVirtualAbstractMethod(TIOManager_Abstract, @TIOManager_Abstract.SetDesktop, 'SetDesktop');
RegisterMethod(@TIOManager_AbstractSetTargetArr_P, 'SetTargetArr');
RegisterMethod(@TIOManager_AbstractSetTargetBmp_P, 'SetTargetBmp');
RegisterMethod(@TIOManager_AbstractSetTargetArr_P, 'SetTargetArray');
RegisterMethod(@TIOManager_AbstractSetTargetBmp_P, 'SetTargetBitmap');
RegisterMethod(@TIOManager_Abstract.TargetValid, 'TargetValid');
RegisterMethod(@TIOManager_Abstract.BitmapDestroyed, 'BitmapDestroyed');
RegisterMethod(@TIOManager_Abstract.GetColor, 'GetColor');