Updated + Added plugins

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@59 3f818213-9676-44b0-a9b4-5e4c4e03d09d

Units/MMLAddon/PSInc/Wrappers/bitmap.inc

@@ -40,7 +40,12 @@ end;
 
 function CreateMirroredBitmap(Bmp : integer) : integer;
 begin;
-  Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp);
+  Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp, MirrorWidth);
+end;
+
+function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;
+begin;
+  Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp,MirrorStyle);
 end;
 
 function FastGetPixel(bmp,x,y : integer) : LongWord;

Units/MMLAddon/PSInc/pscompile.inc

@@ -1,45 +1,47 @@
-
+
-Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
+Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
-Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
+Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
-
+Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
-
+
-Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
+
-Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
+Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
-
+Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
-Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
+
-Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
+Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
-Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
+Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
-Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
+Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
-
+Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
-Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
+
-Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
+Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
-
+Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
-Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
+
-Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
+Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
-Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
+Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
-Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
+Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
-
+Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
-Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
+
-Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
+Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
-Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
+Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
-Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
+Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
-Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
+Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
-Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
+Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
-Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
+Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
-Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
+Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
-Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
+Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
-Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
+Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
-Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
+Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
-Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
+Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
-Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
+Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
-Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
+Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
-Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
+Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
-Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
+Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
-Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
+Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
-
+Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
-
+Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
-
+
-
+
-
+
-
+
-
+
+
+

Units/MMLAddon/mmlpsthread.pas

@@ -5,20 +5,20 @@ unit mmlpsthread;
 interface
 
 uses
-  Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,SynMemo;
+  Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,SynMemo,Plugins,uPSPreProcessor;
 
 type
 
     { TMMLPSThread }
 
     TMMLPSThread = class(TThread)
+      procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
+        Parser: TPSPascalPreProcessorParser; const Active: Boolean;
+        const DirectiveName, DirectiveParam: string; var Continue: Boolean);
     protected
-//      PSScript : TPSScript;
-//      PSClient : TPSScript;
-//        Client: TClient;
-//      DebugTo : TStrings;
       PSScript : TPSScript;
       DebugTo : TSynMemo;
+      PluginsToload : Array of integer;
       procedure OnCompile(Sender: TPSScript);
       procedure AfterExecute(Sender : TPSScript);
       function RequireFile(Sender: TObject; const OriginFileName: String;
@@ -29,11 +29,10 @@ type
       procedure OnThreadTerminate(Sender: TObject);
       procedure Execute; override;
     public
+      Plugins : TMPlugins;
       Client : TClient;
       procedure SetPSScript(Script : string);
       procedure SetDebug( Strings : TSynMemo );
-//      function CompilePSScript : boolean;
-//      function
       constructor Create(CreateSuspended: Boolean);
       destructor Destroy; override;
     end;
@@ -99,12 +98,15 @@ end;
 
 constructor TMMLPSThread.Create(CreateSuspended : boolean);
 begin
+  SetLength(PluginsToLoad,0);
   Client := TClient.Create;
+  Plugins := TMPlugins.Create;
+  Plugins.PluginDirs.Add(ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
 
   PSScript := TPSScript.Create(nil);
   PSScript.UsePreProcessor:= True;
   PSScript.OnNeedFile := @RequireFile;
-
+  PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknowDirective;
   PSScript.OnCompile:= @OnCompile;
   PSScript.OnCompImport:= @OnCompImport;
   PSScript.OnExecImport:= @OnExecImport;
@@ -126,8 +128,10 @@ end;
 
 destructor TMMLPSThread.Destroy;
 begin
+  SetLength(PluginsToLoad,0);
   Client.Free;
   PSScript.Free;
+  Plugins.Free;
   inherited;
 end;
 
@@ -139,13 +143,39 @@ end;
 
 
 
+procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
+  Parser: TPSPascalPreProcessorParser; const Active: Boolean;
+  const DirectiveName, DirectiveParam: string; var Continue: Boolean);
+var
+  TempNum : integer;
+  I,II : integer;
+begin
+  if DirectiveName= 'LOADDLL' then
+    if DirectiveParam <> '' then
+    begin;
+      TempNum := Plugins.LoadPlugin(DirectiveParam);
+      if TempNum < 0 then
+        Writeln(Format('Your DLL %s has not been found',[DirectiveParam]))
+      else
+      begin;
+        for i := High(PluginsToLoad) downto 0 do
+          if PluginsToLoad[i] = TempNum then
+            Exit;
+        SetLength(PluginsToLoad,Length(PluginsToLoad)+1);
+        PluginsToLoad[High(PluginsToLoad)] := TempNum;
+      end;
+    end;
+  Continue:= True;
+end;
 
 procedure TMMLPSThread.OnCompile(Sender: TPSScript);
+var
+  i,ii : integer;
 begin
-  //Here we add all the initalizing, of BMPArray etc
+  for i := high(PluginsToLoad) downto 0 do
-
+    for ii := 0 to Plugins.MPlugins[PluginsToLoad[i]].MethodLen - 1 do
-  // ^ This will all be done with Client.Create;
+      PSScript.AddFunction(Plugins.MPlugins[PluginsToLoad[i]].Methods[i].FuncPtr,
-
+                           Plugins.MPlugins[PluginsToLoad[i]].Methods[i].FuncStr);
   // Here we add all the functions to the engine.
   {$I PSInc/pscompile.inc}
 end;

Units/MMLAddon/plugins.pas

@@ -0,0 +1,178 @@
+unit plugins;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,dynlibs;
+
+type
+  TMPluginMethod = record
+    FuncPtr : pointer;
+    FuncStr : string;
+  end;
+
+  TMPlugin = record
+    Methods : Array of TMPluginMethod;
+    dllHandle : TLibHandle;
+    filename : string;
+    MethodLen : integer;
+  end;
+  TMPluginArray = array of TMPlugin;
+
+  { TMPlugins }
+
+  TMPlugins = class (TObject)
+  private
+    Plugins : TMPluginArray;
+    PluginLen : integer;
+    procedure FreePlugins;
+  public
+    PluginDirs : TStringList;
+    procedure ValidateDirs;
+    procedure LoadPluginsDir( DirIndex : integer);
+    function LoadPlugin(PluginName : string) : integer;
+    property Count : integer read PluginLen;
+    property MPlugins : TMPluginArray read Plugins;
+    constructor Create;
+    destructor Destroy;override;
+  end;
+
+
+
+implementation
+
+uses
+  MufasaTypes,FileUtil;
+
+{ TMPlugins }
+
+procedure TMPlugins.FreePlugins;
+var
+  I : integer;
+begin
+  for i := 0 to PluginLen - 1 do
+  begin;
+    if (Plugins[i].dllHandle > 0) then
+    try
+      FreeLibrary(Plugins[i].dllHandle);
+    except
+    end;
+  end;
+  SetLength(Plugins,0);
+  PluginLen:= 0;
+end;
+
+procedure TMPlugins.ValidateDirs;
+var
+  i : integer;
+  TempStr : string;
+begin
+  for i := 0 to PluginDirs.Count - 1 do
+  begin;
+    if DirectoryExists(PluginDirs.Strings[i]) = false then
+      raise Exception.createFMT('Directory(%s) does not exist',[PluginDirs[i]]);
+    TempStr := PluginDirs.Strings[i];
+    if (TempStr[Length(TempStr)] <> DS) then
+    begin;
+      if (TempStr[Length(TempStr)] = '\') or (TempStr[Length(TempStr)] = '/') then
+        TempStr[Length(TempStr)] := DS
+      else
+        TempStr := TempStr + DS;
+      PluginDirs.Strings[i] := TempStr;
+    end;
+  end;
+end;
+
+procedure TMPlugins.LoadPluginsDir(DirIndex: integer);
+var
+  PlugExt: String = {$IFDEF LINUX}'*.so';{$ELSE}'*.dll';{$ENDIF}
+  FileSearcher : TSearchRec;
+begin
+  if (DirIndex < 0) or (DirIndex >= PluginDirs.Count) then
+    Exit;
+  if FindFirst(PluginDirs.Strings[DirIndex] + PlugExt, faAnyFile, FileSearcher) <> 0 then
+  begin;
+    FindClose(FileSearcher);
+    Exit;
+  end;
+  repeat
+    LoadPlugin(FileSearcher.Name);
+  until FindNext(FileSearcher) <> 0;
+  FindClose(FileSearcher);
+end;
+
+function TMPlugins.LoadPlugin(PluginName: string): Integer;
+var
+  i, ii : integer;
+  pntrArrc     :  function : integer; stdcall;
+  GetFuncInfo  :  function (x: Integer; var ProcAddr: Pointer; var ProcDef: PChar) : Integer; stdcall;
+  GetTypeCount :  function : Integer; stdcall;
+  GetTypeInfo  :  function (x: Integer; var sType, sTypeDef: string): Integer; stdcall;
+  PD : PChar;
+  pntr : Pointer;
+  arrc : integer;
+  Status : LongInt;
+  PlugExt: String = {$IFDEF LINUX}'.so';{$ELSE}'.dll';{$ENDIF}
+begin
+  ii := -1;
+  Result := -1;
+  ValidateDirs;
+  PluginName := ExtractFileNameWithoutExt(PluginName);
+  for i := 0 to PluginDirs.Count - 1 do
+    if FileExists(PluginDirs.Strings[i] + Pluginname + PlugExt) then
+    begin;
+      if ii <> -1 then
+        Raise Exception.CreateFmt('Plugin(%s) has been found multiple times',[PluginName]);
+      ii := i;
+    end;
+  for i := 0 to PluginLen - 1 do
+    if Plugins[i].filename = (PluginDirs.Strings[ii] + PluginName + PlugExt) then
+      Exit(i);
+  pd := StrAlloc(255);
+  SetLength(Plugins,PluginLen + 1);
+  Writeln(Format('Loading plugin %s at %s',[PluginName,PluginDirs.Strings[ii]]));
+  Plugins[PluginLen].filename:= PluginDirs.Strings[ii] + Pluginname + PlugExt;
+  Plugins[PluginLen].dllHandle:= LoadLibrary(PChar(Plugins[PluginLen].filename));
+  if Plugins[PluginLen].dllHandle = 0 then
+    Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]);
+  Pointer(pntrArrc) := GetProcAddress(Plugins[PluginLen].dllHandle, PChar('GetFunctionCount'));
+  if @pntrArrc = nil then
+    Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]);
+  arrc := pntrArrc();
+  SetLength(Plugins[PluginLen].Methods, ArrC);
+  Pointer(GetFuncInfo) := GetProcAddress(Plugins[PluginLen].dllHandle, PChar('GetFunctionInfo'));
+  if @GetFuncInfo = nil then
+    Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]);
+  Plugins[PluginLen].MethodLen := Arrc;
+  for ii := 0 to ArrC-1 do
+  begin;
+    if (GetFuncInfo(ii, pntr, pd) < 0) then
+      Continue;
+    Plugins[Pluginlen].Methods[ii].FuncPtr := pntr;
+    Plugins[Pluginlen].Methods[ii].FuncStr := pd;
+  end;
+  Result := PluginLen;
+  inc(PluginLen);
+  StrDispose(pd);
+
+end;
+
+
+constructor TMPlugins.Create;
+begin
+  inherited Create;
+  PluginLen := 0;
+  PluginDirs := TStringList.Create;
+end;
+
+destructor TMPlugins.Destroy;
+begin
+  FreePlugins;
+  PluginDirs.Free;
+  inherited Destroy;
+end;
+
+end.
+

Units/MMLCore/bitmaps.pas

@@ -49,7 +49,7 @@ type
     function GetBMP(Index : integer) : TMufasaBitmap;
     property Bmp[Index : integer]: TMufasaBitmap read GetBMP;
     function CreateBMP(w, h: integer): Integer;
-    function CreateMirroredBitmap(bitmap: Integer): Integer;
+    function CreateMirroredBitmap(bitmap: Integer; MirrorStyle : TBmpMirrorStyle): Integer;
     function CreateBMPFromFile(const Path : string) : integer;
     function CreateBMPFromString(width,height : integer; Data : string) : integer;
     procedure FreeBMP( Number : integer);
@@ -106,7 +106,8 @@ begin
   BmpArray[Result].Index:= Result;
 end;
 
-function TMBitmaps.CreateMirroredBitmap(bitmap: Integer): Integer;
+function TMBitmaps.CreateMirroredBitmap(bitmap: Integer;
+  MirrorStyle: TBmpMirrorStyle): Integer;
 var
   w,h : integer;
   y,x : integer;
@@ -115,11 +116,22 @@ begin
   Source := Bmp[Bitmap].FData;
   w := BmpArray[Bitmap].Width;
   h := BmpArray[Bitmap].Height;
-  Result := CreateBMP(w,h);
+  if MirrorStyle = MirrorLine then
+    Result := CreateBMP(h,w)
+  else
+    Result := CreateBMP(w,h);
   Dest := BmpArray[Result].FData;
-  for y := (h-1) downto 0 do
+  case MirrorStyle of
-    for x := (w-1) downto 0 do
+    MirrorWidth :  for y := (h-1) downto 0 do
-      Dest[y*w+x] := Source[y*w+w-1-x];
+                     for x := (w-1) downto 0 do
+                       Dest[y*w+x] := Source[y*w+w-1-x];
+    MirrorHeight : for y := (h-1) downto 0 do
+                    Move(Source[y*w],Dest[(h-1 - y) * w],w*SizeOf(TRGB32));
+    MirrorLine :  for y := (h-1) downto 0 do
+                     for x := (w-1) downto 0 do
+                       Dest[x*h+y] := Source[y*w+x];
+
+  end;
 //Can be optmized, this is just proof of concept
 end;
 

Units/MMLCore/mufasatypes.pas

@@ -7,7 +7,10 @@ interface
 
 uses
   Classes, SysUtils;
-
+const
+  DS = DirectorySeparator;
+var
+  MainDir : string;
 type
   TRGB32 = packed record
     B, G, R, A: Byte;
@@ -18,7 +21,7 @@ type
     Ptr : PRGB32;
     IncPtrWith : integer;
   end;
-
+  TBmpMirrorStyle = (MirrorWidth,MirrorHeight,MirrorLine); //LineMirror is in line x=y;
   TTargetWindowMode = (w_BMP, w_Window, w_HDC, w_ArrayPtr, w_XWindow);
   TClickType = (mouse_Left, mouse_Right, mouse_Middle);
   TMousePress = (mouse_Down, mouse_Up);