From fafda03ad0ab7fdaf3b3a1fef9ad30429565781c Mon Sep 17 00:00:00 2001 From: Raymond Date: Sun, 13 Sep 2009 23:22:23 +0000 Subject: [PATCH] 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 | 7 +- Units/MMLAddon/PSInc/pscompile.inc | 92 ++++++------ Units/MMLAddon/mmlpsthread.pas | 54 +++++-- Units/MMLAddon/plugins.pas | 178 +++++++++++++++++++++++ Units/MMLCore/bitmaps.pas | 24 ++- Units/MMLCore/mufasatypes.pas | 7 +- 6 files changed, 296 insertions(+), 66 deletions(-) create mode 100644 Units/MMLAddon/plugins.pas diff --git a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc index bfdc018..6a9c375 100644 --- a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc +++ b/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; diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index 42378f2..48aa2ea 100644 --- a/Units/MMLAddon/PSInc/pscompile.inc +++ b/Units/MMLAddon/PSInc/pscompile.inc @@ -1,45 +1,47 @@ - -Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer'); -Sender.Comp.AddTypeS('TPointArray','Array of TPoint'); - - -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(@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(@Wait, 'procedure wait(t: integer);'); -Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h: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(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);'); -Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;'); -Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;'); -Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);'); -Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);'); -Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;'); -Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);'); -Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);'); -Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;'); -Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;'); -Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)'); -Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);'); -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);'); - - - - - - - + +Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer'); +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(@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(@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(@Wait, 'procedure wait(t: integer);'); +Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h: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(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);'); +Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;'); +Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;'); +Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);'); +Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);'); +Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;'); +Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;'); +Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);'); +Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);'); +Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;'); +Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;'); +Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)'); +Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);'); +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);'); + + + + + + + diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index aa992fd..6e1423d 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/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 - - // ^ This will all be done with Client.Create; - + for i := high(PluginsToLoad) downto 0 do + for ii := 0 to Plugins.MPlugins[PluginsToLoad[i]].MethodLen - 1 do + 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; diff --git a/Units/MMLAddon/plugins.pas b/Units/MMLAddon/plugins.pas new file mode 100644 index 0000000..a96d19e --- /dev/null +++ b/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. + diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 19b7e86..198e938 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/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 - for x := (w-1) downto 0 do - Dest[y*w+x] := Source[y*w+w-1-x]; + case MirrorStyle of + MirrorWidth : for y := (h-1) downto 0 do + 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; diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 09b6647..6daca81 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/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);