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

Extensions/dtm_editor.sex

@@ -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);
-  //GetClientDimensions(w, h);
+  bmp.CopyClientToBitmap(client.IOManager,true,0,0,0,0,w-1,h-1);
-  //bmp.SetSize(w, h);
-  //CopyClientToBitmap(bmp.Index, 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);
+    mdtm := SDTMToMDTM(toSDTM);
-    AddDTM(mdtm);
-
     WriteLn('');
     WriteLn(mdtm.ToString);
     WriteLn('');
-    mdtm.Free;}
+    mdtm.Free;
   end;
 end;
 

Includes/mml.simba

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

Projects/Simba/psextension.pas

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

Units/MMLAddon/PSInc/Wrappers/internets.inc

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

Units/MMLAddon/PSInc/uPSC_mml.pas

@@ -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 SetTargetArray( ArrPtr : Integer; Size : TPoint) : integer;');
-    RegisterMethod('Function SetTargetBmp( bmp : TMufasaBitmap) : integer;');
+    RegisterMethod('Function SetTargetBitmap( bmp : TMufasaBitmap) : integer;');
     RegisterMethod('Function TargetValid : Boolean');
     RegisterMethod('Procedure BitmapDestroyed( Bitmap : TMufasaBitmap)');
     RegisterMethod('Function GetColor( x, y : integer) : TColor');

Units/MMLAddon/PSInc/uPSR_mml.pas

@@ -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_AbstractSetTargetArr_P, 'SetTargetArray');
-    RegisterMethod(@TIOManager_AbstractSetTargetBmp_P, 'SetTargetBmp');
+    RegisterMethod(@TIOManager_AbstractSetTargetBmp_P, 'SetTargetBitmap');
     RegisterMethod(@TIOManager_Abstract.TargetValid, 'TargetValid');
     RegisterMethod(@TIOManager_Abstract.BitmapDestroyed, 'BitmapDestroyed');
     RegisterMethod(@TIOManager_Abstract.GetColor, 'GetColor');