Added some exported functions to port SRL.

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

trunk/Units/MMLAddon/PSInc/Wrappers/colour.inc

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

trunk/Units/MMLAddon/PSInc/Wrappers/math.inc

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

trunk/Units/MMLAddon/PSInc/Wrappers/other.inc

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

trunk/Units/MMLAddon/PSInc/pscompile.inc

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

trunk/Units/MMLAddon/PSInc/psexportedmethods.inc

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

trunk/Units/MMLAddon/mmlpsthread.pas

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

trunk/Units/MMLCore/bitmaps.pas

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

trunk/Units/MMLCore/colour_conv.pas

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

trunk/Units/MMLCore/finder.pas

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