marpis
2011-12-04 06:01:18
I'm really not good with plugins really. Could someone build this for me?
I hope it doesn't have too many errors.
I hope it doesn't have too many errors.
library sps;
{$mode objfpc}{$H+}
uses
Classes, sysutils, FileUtil, Interfaces, mufasatypes, bitmaps;
type
T3DIntegerArray = array of T2DIntegerArray;
T4DIntegerArray = array of T3DIntegerArray;
function SPS_ColorBoxesMatchInline(B1, B2: TIntegerArray; tol: extended): boolean; inline;
var
oneMinusTol, tolPlusOne: extended;
begin
oneMinusTol := 1 - tol;
tolPlusOne := tol + 1;
Result := ((B1[0] >= Round(B2[0] * oneMinusTol)) and
(B1[0] <= Round(B2[0] * tolPlusOne))) and
((B1[1] >= Round(B2[1] * oneMinusTol)) and
(B1[1] <= Round(B2[1] * tolPlusOne))) and
((B1[2] >= Round(B2[2] * oneMinusTol)) and
(B1[2] <= Round(B2[2] * tolPlusOne)));
end;
// Edited for SPS2
function SPS_MakeColorBox(bmp: TMufasaBitmap; x1, y1, SideLength: integer): TIntegerArray;
var
x, y, width: integer;
C: TRGB32;
begin
SetLength(Result, 3);
width := bmp.Width; // may not be necessary, but should help a bit.
for x := (x1 + SideLength - 1) downto x1 do // flipped these to downto since order is irrelevant
for y := (y1 + SideLength - 1) downto y1 do // downto will calc the initial only once rather than each time.
begin
try
C := bmp.FData[y * width + x];
Result[0] := Result[0] + C.R;
Result[1] := Result[1] + C.G;
Result[2] := Result[2] + C.B;
except end;
end;
end;
function SPS_GetProfile(View: TMufasaBitmap): integer; register;
var
i, ii: integer;
ProfileAsArray: Array [0..2] of integer;
TIA: TIntegerArray;
begin
TIA := SPS_MakeColorBox(View, 0, 0, 100);
for i := 0 to 2 do
for ii := 1 to 10 do
if (TIA[i] / 10000.0) <= (25.5*ii) then
begin
ProfileAsArray[i] := ii - 1;
Break;
end;
Result := ProfileAsArray[0] + ProfileAsArray[1]*10 + ProfileAsArray[2]*100;
end;
function SPS_BitmapToMap(bmp: TMufasaBitmap; SideLength: integer): T3DIntegerArray; register;
var
X, Y, HighX, HighY: integer;
begin
HighX := Trunc(bmp.Width / (SideLength*1.0));
HighY := Trunc(bmp.Height / (SideLength*1.0));
SetLength(Result, HighX);
for X := 0 to HighX - 1 do
begin
SetLength(Result[X], HighY);
for Y := 0 to HighY - 1 do
begin
Result[X][Y] := SPS_MakeColorBoxEx(bmp, X * SideLength, Y * SideLength);
end;
end;
end;
function SPS_FindMapInMap(out fx, fy: integer; LargeMap: T4DIntegerArray; SmallMap: T3DIntegerArray; tol: extended; out FoundMatches: integer): integer; register;
var
x, y, HighX, HighY, cm, L: integer;
xx, yy: integer;
Matching, BestMatch: integer;
BoxesLeftInView, SideLength: integer;
BoxesInViewRow, TotBoxesInView: integer;
b: Boolean;
begin
fX := -1;
fY := -1;
BestMatch := 0;
SideLength := 100 / Length(SmallMap);
BoxesInViewRow := 100 / SideLength;
TotBoxesInView := sqr(BoxesInViewRow);
L := Length(LargeMap);
Result := -1;
for cm := 0 to L-1 do
begin
HighX := High(LargeMap[cm]) - BoxesInViewRow - 1;
HighY := High(LargeMap[cm][0]) - BoxesInViewRow - 1;
for x := 0 to HighX do
for y := 0 to HighY do
begin
// Reset these in the beginning of every view (100x100 pixels)
Matching := 0;
BoxesLeftInView := TotBoxesInView;
for xx := (BoxesInViewRow - 1) downto 0 do
for yy := (BoxesInViewRow - 1) downto 0 do
begin
// added 26.11.2011 to improve speed
// will stop going through the area if it's not possibly better than
// the best one found.
if (BoxesLeftInView + Matching) <= BestMatch then
Break;
Dec(BoxesLeftInView);
b:= SPS_ColorBoxesMatchInline(LargeMap[cm][x+xx][y+yy], SmallMap[xx][yy], tol);
if (b) then Inc(Matching);
end;
if (Matching > BestMatch) then
begin
BestMatch := Matching;
Result := cm;
fX := x;
fY := y;
end;
end;
end;
if (Result > -1) then
begin
// moved outside to remove uncessary calculations in interations.
fX := fX * SideLength + 50; // +50 cause we want the center
fy := fY * SideLength + 50;
FoundMatches := BestMatch;
end;
end;
function SPS_CropArea(x1, y1, x2, y2: integer; Area: T3DIntegerArray): T3DIntegerArray;
var
x, y, i: integer;
begin
SetLength(Result, x2 - x1 + 1);
for x := (x2 - x1) downto 0 do
begin
SetLength(Result[x], y2 - y1 + 1);
for y := (y2 - y1) downto 0 do
begin
SetLength(Result[x][y], 3);
for i := 0 to 2 do
Result[x][y][i] := Area[x1 + x][y1 + y][i];
end;
end;
end;
function SPS_GetMyPosEx(ViewBitmap: TMufasaBitmap; AreaBitmaps: array of TMufasaBitmap; tol: extended; out FoundMatches, AreaIndex: integer): TPoint; register;
var
x, y, i, L: integer;
MaxW, MaxHH: integer;
Minimap: T3DIntegerArray;
WorldMap: T4DIntegerArray;
NewTargetArea: T3DIntegerArray;
begin
L := Length(AreaBitmaps);
SetLength(Worldmap, L);
Dec(L);
Minimap := SPS_BitmapToMap(ViewBitmap, 25);
for i := 0 to L do
Worldmap[i] := SPS_BitmapToMap(AreaBitmaps[i], 25);
AreaIndex := SPS_FindMapInMap(x, y, Worldmap, Minimap, tol, FoundMatches);
SetLength(Worldmap, 1);
Worldmap[0] := SPS_BitmapToMap(AreaBitmaps[AreaIndex], 2);
Minimap := SPS_BitmapToMap(ViewBitmap, 2);
MaxW := High(Worldmap[0]);
MaxH := High(Worldmap[0][0]);
NewTargetArea := SPS_CropArea(Max(0, x - 125), Max(0, y - 125),
Min(MaxW, x + 125), Min(MaxH, y + 125));
SPS_FindMapInMap(Result.x, Result.y, NewTargetArea, Minimap, tol, FoundMatches);
end;
////// EXPORTING /////////////////////////////////////////////////////////////
procedure SetPluginMemoryManager(MemMgr : TMemoryManager); stdcall; export;
begin
SetMemoryManager(MemMgr);
end;
function GetTypeCount(): Integer; stdcall; export;
begin
Result := 2;
end;
function GetTypeInfo(x: Integer; var sType, sTypeDef: string): integer; stdcall; export;
begin
case x of
0: begin
sType := 'T3DIntegerArray';
sTypeDef := 'array of T2DIntegerArray;';
end;
1: begin
sType := 'T4DIntegerArray';
sTypeDef := 'array of T3DIntegerArray;';
end;
else
x := -1;
end;
Result := x;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 4;
end;
function GetFunctionCallingConv(x : Integer) : Integer; stdcall; export;
begin
Result := 0;
case x of
0..3: Result := 1;
end;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall; export;
begin
case x of
0:
begin
ProcAddr := @SPS_FindMapInMap;
StrPCopy(ProcDef, 'function SPS_FindMapInMap(out fx, fy: integer; LargeMap: T4DIntegerArray; SmallMap: T3DIntegerArray; tol: extended; out FoundMatches: integer): integer;');
end;
1:
begin
ProcAddr := @SPS_BitmapToMap;
StrPCopy(ProcDef, 'function SPS_BitmapToMap(bmp: TMufasaBitmap; SideLength: integer): T3DIntegerArray;');
end;
2:
begin
ProcAddr := @SPS_GetProfile;
StrPCopy(ProcDef, 'function SPS_GetProfile(View: TMufasaBitmap): integer;');
end;
3:
begin
ProcAddr := @SPS_GetMyPosEx;
StrPCopy(ProcDef, 'function SPS_GetMyPosEx(ViewBitmap: TMufasaBitmap; AreaBitmaps: array of TMufasaBitmap; tol: extended; out FoundMatches, AreaIndex: integer): TPoint;');
end;
else
x := -1;
end;
Result := x;
end;
exports SetPluginMemoryManager;
exports GetTypeCount;
exports GetTypeInfo;
exports GetFunctionCount;
exports GetFunctionInfo;
exports GetFunctionCallingConv;
begin
end.