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

Added some exported functions to port SRL.

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@461 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2010-01-24 20:22:47 +00:00
parent 73a9e15650
commit 562fe21116
9 changed files with 116 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
trunk/Units/MMLAddon/PSInc/Wrappers/colour.inc
View File

@ -26,6 +26,11 @@ begin;
Result := CurrThread.Client.IOManager.GetColor(x,y);
end;
function GetColors(Coords : TPointArray) : TIntegerArray;
begin
result := CurrThread.Client.MFinder.GetColors(coords);
end;
function findcolor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;
begin
Result := CurrThread.Client.MFinder.FindColor(x, y, color, x1, y1, x2, y2);

32
trunk/Units/MMLAddon/PSInc/Wrappers/math.inc
View File

@ -30,3 +30,35 @@ function ps_RandomRange(const aFrom, aTo: Integer): Integer;
begin
Result:=Random(Abs(aFrom-aTo))+Min(aTo,AFrom);
end;
function Factorial(number: longword): Int64;
var
Loop : longword;
begin
result := 1;
for loop := number downto 2 do
result := result * loop;
end;
function BinCoe(a, b: LongInt): Extended;
begin
result := Factorial(a) / (factorial(b) * factorial(a-b));
end;
function FixD(Degrees : extended) : Extended;
begin;
Result := Degrees;
while Result < 0 do
Result := Result + 360;
while Result > 360 do
Result := Result - 360;
end;
procedure psSwap(var A,B);
var
TempPtr : Pointer;
begin;
TempPtr := pointer(A);
pointer(a) := pointer(b);
pointer(b) := TempPtr;
end;

5
trunk/Units/MMLAddon/PSInc/Wrappers/other.inc
View File

@ -73,6 +73,11 @@ begin;
result.y2 := y2;
end;
function IntInBox(x, y: Integer; Box: TBox): Boolean;
begin;
result := (((x >= Box.x1) and(x <= Box.x2)) and ((y >= box.y1) and (y <= box.y2)));
end;
function Distance(x1, y1, x2, y2: Integer): Integer;
begin;
Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));

4
trunk/Units/MMLAddon/PSInc/pscompile.inc
View File

@ -26,7 +26,7 @@ Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath)
Sender.Comp.AddConstantN('IncludePath','string').SetString(CurrThread.IncludePath);
Sender.Comp.AddConstantN('PluginPath','string').SetString(CurrThread.PluginPath);
Sender.Comp.AddConstantN('FontPath','string').SetString(CurrThread.FontPath);
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
Sender.Comp.AddTypeS('TIntegerArray', 'Array of LongInt');
Sender.Comp.AddTypeS('TExtendedArray','Array of extended');
Sender.Comp.AddTypeS('TBoolArray', 'Array of Boolean');
Sender.Comp.AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;');
@ -35,7 +35,7 @@ Sender.Comp.AddTypeS('T2DPointArray','Array of Array of TPoint');
Sender.Comp.AddTypeS('TPointArrayArray','Array of Array of TPoint');
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.Comp.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
Sender.Comp.addtypeS('PPoint','record R,T : extended; end;');
Sender.Comp.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
Sender.Comp.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;');

5
trunk/Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -48,11 +48,15 @@ AddFunction(@max,'function Max(a, b: Integer): Integer;');
AddFunction(@min,'function Min(a, b: Integer): Integer;');
AddFunction(@minE,'function MinE(a, b: extended): Extended;');
AddFunction(@IntToBox,'function IntToBox(x1,y1,x2,y2 : integer) : TBox;');
AddFunction(@IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;');
AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
AddFunction(@hypot,'function Hypot(X, Y: Extended): Extended;');
AddFunction(@ps_RandomRange,'function RandomRange(aFrom,aTo: Integer): Integer;');
AddFunction(@BinCoe,'function BinCoe(a, b: LongInt): Extended;');
AddFunction(@FixD,'function FixD(Degrees : extended) : Extended;');
AddFunction(@InRange,'function InRange(value,min,max : integer) : boolean;');
{window}
SetCurrSection('Window');
@ -139,6 +143,7 @@ AddFunction(@GetToleranceSpeed, 'function GetToleranceSpeed: Integer;');
AddFunction(@SetToleranceSpeed2Modifiers, 'procedure SetToleranceSpeed2Modifiers(nHue, nSat: Extended);');
AddFunction(@GetToleranceSpeed2Modifiers, 'procedure GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);');
AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
AddFunction(@GetColors,'function GetColors(Coords : TPointArray) : TIntegerArray;');
AddFunction(@FindColor, 'function FindColor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function FindColorToleranceOptimised(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function FindColorTolerance(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');

39
trunk/Units/MMLAddon/mmlpsthread.pas
View File

@ -167,13 +167,36 @@ begin
psWriteln(makeString(NewTPSVariantIFC(Stack[Stack.Count-1],false)));
end;
function swap_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
Param1,Param2: TPSVariantIFC;
tempCopy : pointer;
begin
Result:=true;
Param1 := NewTPSVariantIFC(Stack[Stack.count-1],true);
Param2 := NewTPSVariantIFC(Stack[Stack.count-2],true);
if Param1.aType.BaseType <> Param2.aType.BaseType then
exit(false)
else
begin
Param1.aType.CalcSize;
param2.aType.CalcSize;
if Param1.aType.RealSize <> Param2.aType.RealSize then
exit(false);
GetMem(tempcopy,Param1.aType.RealSize);
Move(Param1.Dta^,tempCopy^,param1.atype.realsize);
Move(Param2.Dta^,Param1.Dta^,param1.atype.realsize);
Move(tempCopy^,Param2.Dta^,param1.atype.realsize);
Freemem(tempcopy);
end;
end;
function ToStr_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
data: TPSVariantIFC;
begin
result := true;
Stack.SetAnsiString(-1, MakeString(NewTPSVariantIFC(Stack[Stack.Count-2],false)));
end;
function NewThreadCall(Procname : string) : Cardinal;
@ -444,6 +467,19 @@ begin
OrgName:= 'x';
Mode:= pmIn;
end;
with x.AddFunction('procedure swap;').decl do
begin
with addparam do
begin
OrgName:= 'x';
Mode:= pmInOut;
end;
with addparam do
begin
OrgName:= 'y';
Mode:= pmInOut;
end;
end;
end;
procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec;
@ -459,6 +495,7 @@ begin
RIRegister_Mufasa(x);
se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil);
se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil);
se.RegisterFunctionName('SWAP',@swap_,nil,nil);
end;
procedure TMMLPSThread.OutputMessages;

5
trunk/Units/MMLCore/bitmaps.pas
View File

@ -442,11 +442,6 @@ begin;
Result.B := Color shr 16 and $ff;
end;
function BGRToRGB(BGR : TRGB32) : TColor;inline;
begin;
Result := BGR.R or BGR.g shl 8 or BGR.b shl 16;
end;
function TMufasaBitmap.Copy: TMufasaBitmap;
begin
Result := TMufasaBitmap.Create;

8
trunk/Units/MMLCore/colour_conv.pas
View File

@ -29,7 +29,7 @@ interface
uses
Classes, SysUtils,
Graphics,
Graphics, mufasatypes,
Math;
@ -46,6 +46,8 @@ Procedure ColorToHSL(Col: Integer; out h, s, l: Extended); inline;
procedure ColorToXYZ(color: Integer; out X, Y, Z: Extended); inline;
function XYZToColor(X, Y, Z: Extended): TColor; inline;
function HSLToColor(H, S, L: Extended): TColor; inline;
function BGRToRGB(BGR : TRGB32) : TColor;inline;
implementation
@ -54,6 +56,10 @@ Const
OneDivThree = 1/3.0;
TwoDivThree = 2 / 3.0;
OneDivTwoPointFour = 1 / 2.4;
function BGRToRGB(BGR : TRGB32) : TColor;inline;
begin;
Result := BGR.R or BGR.g shl 8 or BGR.b shl 16;
end;
Function RGBtoColor(r,g,b : byte): TColor; overload; inline;
begin;

23
trunk/Units/MMLCore/finder.pas
View File

@ -84,7 +84,8 @@ type
function FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean;
function FindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
function FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray; maxToFind: Integer): Boolean;
//Donno
function GetColors(Coords: TPointArray): TIntegerArray;
// tol speeds
procedure SetToleranceSpeed(nCTS: Integer);
function GetToleranceSpeed: Integer;
@ -104,6 +105,7 @@ uses
colour_conv,// For RGBToColor, etc.
Client, // For the Client Casts.
math, //min/max
tpa, //TPABounds
dtmutil
;
type
@ -2003,4 +2005,23 @@ begin
raise Exception.CreateFmt('Not done yet!', []);
end;
function TMFinder.GetColors(Coords: TPointArray): TIntegerArray;
var
Box : TBox;
Len, I,w,h : integer;
PtrRet : TRetData;
Ptr : PRGB32;
begin
len := high(Coords);
setlength(result,len+1);
box := GetTPABounds(coords);
w := 0;
h := 0;
DefaultOperations(w,h,box.x2,box.y2);
TClient(Self.Client).IOManager.GetDimensions(w,h);
PtrRet := TClient(Client).IOManager.ReturnData(0,0,Box.x2 + 1,box.y2+ 1);//Otherwise lotsashit.
ptr := PtrRet.Ptr;
for i := 0 to len do
Result[i] := BGRToRGB(Ptr[Coords[i].y*w + Coords[i].x]);
end;
end.