Boreas
2007-08-24 15:38:39
Here is new DoorProfiles.scar
Here is test script
Please test accuracy and speed. It should get the correct number of doors on the minimap (IE not mistake drop dots). If it takes more than 500ms for you guys (100-200 for me) then there is another idea I can add. Please test in places with different amount of doors, some diagonal doors (like in draynor), different amount of drop dots, and try it on a world where the door color is 233,205,217, or 241.
If anyone gets over 500ms, or gets a drop dot mistaken as a door, I have more work to do. Other than that, I don't see any other changes to be made.
Thankyou.
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ยป Door Routines --//
//-----------------------------------------------------------------//
type
DoorProfile = record
Points: array of TPoint;
MidPoint: TPoint;
PixelCount: Integer;
Slope: Extended;
Color: Integer;
end;
{*******************************************************************************
function GetDoorColor: Integer;
By: Boreas
Description: Finds first door color it comes to. Ignores drop dots :)
*******************************************************************************}
function GetDoorColor: Integer;
var
Color, tmpx, tmpy, MinOfRange: Integer;
Length206, Length217, Length233, Length241: Integer;
Array206, Array217, Array233, Array241: TPointArray;
RangeOfOthers206, RangeOfOthers217, RangeOfOthers233, RangeOfOthers241: Integer;
tmpbool: Boolean;
begin
for Color := 200 to 254 do
begin
if not (((Color = 206) or (Color = 217) or (Color = 233) or (Color = 241))) then
begin
if FindColorCircle(tmpx, tmpy, Color, mmcx, mmcy, 70) then
begin
Result := Color;
tmpbool := True;
end;
end;
if tmpbool then Break;
end;
if not (tmpbool) then
begin
//writeln('its a drop dot color');
FindColorsTolerance(Array206, 206, mmx1, mmy1, mmx2, mmy2, 0);
Length206 := getarraylength(Array206);
FindColorsTolerance(Array217, 217, mmx1, mmy1, mmx2, mmy2, 0);
Length217 := getarraylength(Array217);
FindColorsTolerance(Array233, 233, mmx1, mmy1, mmx2, mmy2, 0);
Length233 := getarraylength(Array233);
FindColorsTolerance(Array241, 241, mmx1, mmy1, mmx2, mmy2, 0);
Length241 := getarraylength(Array241);
RangeOfOthers206 := Max(Length233, Max(Length217, Length241)) - Min(Length233, Min(Length217, Length241));
RangeOfOthers217 := Max(Length233, Max(Length206, Length241)) - Min(Length233, Min(Length206, Length241));
RangeOfOthers233 := Max(Length206, Max(Length217, Length241)) - Min(Length206, Min(Length217, Length241));
RangeOfOthers241 := Max(Length233, Max(Length217, Length206)) - Min(Length233, Min(Length217, Length206));
MinOfRange := Min(RangeOfOthers206, Min(RangeOfOthers217, Min(RangeOfOthers233, RangeOfOthers241)));
////////Added in V2///////
if (Length206 = Length217) and (Length217 = Length233) and (Length233 = Length241) then
begin
Result := 0;
Exit;
end;
///////////////////////////
case MinOfRange of
RangeOfOthers206: Result := 206;
RangeOfOthers217: Result := 217;
RangeOfOthers233: Result := 233;
RangeOfOthers241: Result := 241;
end;
end;
end;
{*******************************************************************************
function GetSecondDoorColor(First: Integer): Integer;
By: Boreas
Description: Finds first door color except for First. Ignores drop dots :)
*******************************************************************************}
function GetSecondDoorColor(First: Integer): Integer;
var
Color, tmpx, tmpy, MinOfRange: Integer;
Length206, Length217, Length233, Length241: Integer;
Array206, Array217, Array233, Array241: array of TPoint;
RangeOfOthers206, RangeOfOthers217, RangeOfOthers233, RangeOfOthers241: Integer;
tmpbool: Boolean;
begin
for Color := 200 to 254 do
begin
if not (((Color = 206) or (Color = 217) or (Color = First) or (Color = 233) or (Color = 241))) then
begin
if FindColorCircle(tmpx, tmpy, Color, mmcx, mmcy, 70) then
begin
Result := Color;
tmpbool := True;
end;
end;
if tmpbool then Break;
end;
if not (tmpbool) then
begin
//writeln('its a drop dot color');
FindColorsTolerance(Array206, 206, mmx1, mmy1, mmx2, mmy2, 0);
Length206 := getarraylength(Array206);
FindColorsTolerance(Array217, 217, mmx1, mmy1, mmx2, mmy2, 0);
Length217 := getarraylength(Array217);
FindColorsTolerance(Array233, 233, mmx1, mmy1, mmx2, mmy2, 0);
Length233 := getarraylength(Array233);
FindColorsTolerance(Array241, 241, mmx1, mmy1, mmx2, mmy2, 0);
Length241 := getarraylength(Array241);
RangeOfOthers206 := Max(Length233, Max(Length217, Length241)) - Min(Length233, Min(Length217, Length241));
RangeOfOthers217 := Max(Length233, Max(Length206, Length241)) - Min(Length233, Min(Length206, Length241));
RangeOfOthers233 := Max(Length206, Max(Length217, Length241)) - Min(Length206, Min(Length217, Length241));
RangeOfOthers241 := Max(Length233, Max(Length217, Length206)) - Min(Length233, Min(Length217, Length206));
MinOfRange := Min(RangeOfOthers206, Min(RangeOfOthers217, Min(RangeOfOthers233, RangeOfOthers241)));
////////Added in V2///////
if (Length206 = Length217) and (Length217 = Length233) and (Length233 = Length241) then
begin
Result := 0;
Exit;
end;
///////////////////////////
case MinOfRange of
RangeOfOthers206: Result := 206;
RangeOfOthers217: Result := 217;
RangeOfOthers233: Result := 233;
RangeOfOthers241: Result := 241;
end;
if ((Length241 = Length233) and (Length233 = Length217) and (Length217 = Length206)) then
Result := first;
end;
end;
{*******************************************************************************
function AddTPA(First, Second: array of TPoint): array of TPoint;
By: Boreas
Description: Adds two TPoint arrays into a larger TPoint array
*******************************************************************************}
function AddTPA(First, Second: array of TPoint): array of TPoint;
var
length1, length2, pArray: Integer;
begin
length1 := getarraylength(first);
setarraylength(Result, length1);
Result := first;
length2 := getarraylength(second);
setarraylength(Result, (length1 + length2));
for pArray := length1 to (length1 + length2 - 1) do
begin
Result[parray] := second[parray - length1];
end;
end;
{*******************************************************************************
function Nearby(FirstTP, SecondTP: TPoint): Boolean;
By: Boreas
Description: Returns true if one point is next to another
222
212
222
*******************************************************************************}
function Nearby(FirstTP, SecondTP: TPoint): Boolean;
begin
if ((FirstTP.x + 1 = SecondTP.x) or
(FirstTP.x = SecondTP.x) or
(FirstTP.x - 1 = SecondTP.x)) and
((FirstTP.y + 1 = SecondTP.y) or
(FirstTP.y = SecondTP.y) or
(FirstTP.y - 1 = SecondTP.y)) then
Result := True;
end;
{*******************************************************************************
function SplitTPA(OldArray: array of TPoint): array of array of TPoint;
By: Boreas
Description: Splits a TPA into multiple TPAs so that each TPA contains
points that are next to each. Example, you have an array of all points
containing the door color, this would split it up so that each array
has its own door.
*******************************************************************************}
function SplitTPA(OldArray: array of TPoint): array of array of TPoint;
var
pFirst, pSecond, pThird: Integer;
OldLength: Integer;
NewLength, tmpLength: Integer;
begin
OldLength := getarraylength(OldArray);
for pFirst := 0 to OldLength - 1 do
begin
if not ((OldArray[pFirst].x = 0) {and(OldArray[pFirst].y=0)}) then
begin
tmpLength := 0;
NewLength := NewLength + 1;
setarraylength(Result, NewLength);
tmpLength := tmpLength + 1
setarraylength(Result[NewLength - 1], tmpLength);
Result[NewLength - 1][0] := OldArray[pFirst];
OldArray[pFirst].x := 0;
pSecond := -1;
repeat
pSecond := pSecond + 1;
for pThird := 0 to OldLength - 1 do
begin
if not ((OldArray[pThird].x = 0) {and(OldArray[pFirst].y=0)}) then
begin
if Nearby(OldArray[pThird], Result[NewLength - 1][pSecond]) then
begin
tmpLength := tmpLength + 1
setarraylength(Result[NewLength - 1], tmpLength);
Result[NewLength - 1][tmpLength - 1] := OldArray[pThird];
OldArray[pThird].x := 0;
//OldArray[pThird].y:=0;
end;
end;
end;
until pSecond = tmplength - 1;
end;
end;
end;
{*******************************************************************************
function IsTPointInDropDot(TP: TPoint): Boolean;
By: Boreas
Description: Returns true if a point, that is one of the 4 constant drop dot
colors, is in a drop dot. Works with partial covering.
*******************************************************************************}
function IsTPointInDropDot(TP: TPoint; LotsOfDots:boolean): Boolean;
var
color: Integer;
begin {
16777215 3553023 789758 16777215
3553023 2105598 395004 233
789758 395004 241 206
65536 217 188 65536
16777215 65536 65536 16777215
}
if LotsOfDots then
begin
end;
result:=true;
color := getcolor(TP.x, TP.y);
case color of
206:
begin
if not(getcolor(TP.x, TP.y - 1) = 233)
then if not(getcolor(TP.x - 1, TP.y-1) = 395004)
then if not(getcolor(TP.x , TP.y+1) = 65536)
then if not(getcolor(TP.x-1 , TP.y+1) = 188)
then if not(getcolor(TP.x - 1, TP.y) = 241)
then if not(getcolor(TP.x - 2, TP.y + 1) = 217) then
Result := false;
end;
217:
begin
if (getcolor(TP.x + 1, TP.y - 1) = 241)
or (getcolor(TP.x + 2, TP.y - 1) = 206)
or (getcolor(TP.x + 2, TP.y - 2) = 233) then
Result := True;
end;
233:
begin
if (getcolor(TP.x, TP.y + 1) = 206)
or (getcolor(TP.x - 1, TP.y + 1) = 241)
or (getcolor(TP.x - 2, TP.y + 2) = 217) then
Result := True;
end;
241:
begin
if (getcolor(TP.x + 1, TP.y - 1) = 233)
or (getcolor(TP.x + 1, TP.y) = 206)
or (getcolor(TP.x - 1, TP.y + 1) = 217) then
Result := True;
end;
else Result := False;
end;
end;
{*******************************************************************************
function IgnoreDropDots(TheList: array of array of TPoint): array of array of TPoint;
By: Boreas
Description:
*******************************************************************************}
function IgnoreDropDots(TheList: array of TPoint; LotsOfDots:boolean): array of TPoint;
var
pTo, pFrom: Integer;
pList: Integer;
begin
Result := TheList;
for pFrom := 0 to getarraylength(Result) - 1 do
begin
if not (IsTPointInDropDot(Result[pFrom],LotsOfDots)) then
begin
Result[pTo] := Result[pFrom];
pTo := pTo + 1;
end;
end;
setarraylength(Result, pto);
end;
{*******************************************************************************
function GetAllDoorPixels: array of array of TPoint;
By: Boreas
Description: Returns an array of array of tpoints, with each array containing
the points of a different door on the minimap.
*******************************************************************************}
function GetAllDoorPixels: array of array of TPoint;
var
DoorColor1, DoorColor2: Integer;
tmpTPA1, tmpTPA2, tmpTPA3,DropDots: array of TPoint;
tmpAOTPA: array of array of TPoint;
DropDotColor,LotsOfDots:boolean;
begin
DoorColor1 := GetDoorcolor;
DoorColor2 := GetSecondDoorColor(DoorColor1);
writeln(inttostr(doorcolor1));
writeln(inttostr(doorcolor2));
DropDotColor:=true;
if not(doorcolor1=233) then
if not(doorcolor1=241) then
if not(doorcolor1=217) then
if not(doorcolor1=206) then
if not(doorcolor2=233) then
if not(doorcolor2=241) then
if not(doorcolor2=217) then
if not(doorcolor2=206) then
DropDotColor:=false;
if DropDotColor then
begin
FindColorsTolerance(DropDots, 395004, mmx1, mmy1, mmx2, mmy2, 0);
end;
//
////////Added in V2///////
if (DoorColor1 = DoorColor2) then
DoorColor1 := 0;
if (DoorColor1 = 0) and (DoorColor2 = 0)then
Exit;
///////////////////////////
FindColorsTolerance(tmpTPA1, DoorColor1, mmx1, mmy1, mmx2, mmy2, 0);
FindColorsTolerance(tmpTPA2, DoorColor2, mmx1, mmy1, mmx2, mmy2, 0);
////////Added in V2///////
if not(DoorColor1 = DoorColor2) then
tmpTPA3 := AddTPA(tmpTPA1, tmpTPA2);
if DoorColor1 = 0 then
tmpTPA3 := tmpTPA2;
if DoorColor2 = 0 then
tmpTPA3 := tmpTPA1;
///////////////////////////
// writeln('door color'+inttostr(getcolor(tmptpa3[0].x,tmptpa3[0].y)));
if DropDotColor then
begin
if (getarraylength(DropDots)*2)>(getarraylength(tmpTPA3)) then
LotsOfDots:=true;
tmpTPA3 := IgnoreDropDots(tmpTPA3,LotsOfDots);
end;
Result := SplitTPA(tmpTPA3);
end;
{*******************************************************************************
function RearrangeTPA(thearray: array of TPoint; startpt, endpt: Integer; dox, up: Boolean): array of TPoint;
By: Boreas
Description: Sorts an tpoint array by X or Y, up or down, and returns a section
of it.
*******************************************************************************}
function RearrangeTPA(thearray: array of TPoint; startpt, endpt: Integer; dox, up: Boolean): array of TPoint;
var
temp, pArray: Integer;
done: Boolean;
ttp: TPoint;
tmpTPA: array of TPoint;
begin
setarraylength(tmpTPA, getarraylength(thearray));
tmpTPA := thearray;
setarraylength(Result, endpt + 1 - startpt);
if not (up) then
begin
if dox then
begin
repeat
done := True;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if (tmpTPA[pArray].x < tmpTPA[pArray + 1].x) then
begin
//temp := tmpTPA[pArray].x;
//tmpTPA[pArray].x := tmpTPA[pArray + 1].x;
//tmpTPA[pArray + 1].x := temp;
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := False;
end;
end;
until (done);
end;
if not (dox) then
begin
repeat
done := True;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if (tmpTPA[pArray].y < tmpTPA[pArray + 1].y) then
begin
//temp := thearray[pArray].y;
//tmpTPA[pArray].y := tmpTPA[pArray + 1].y;
//tmpTPA[pArray + 1].y := temp;
ttp := thearray[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := False;
end;
end;
until (done);
end;
end;
if up then
begin
if dox then
begin
repeat
done := True;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if (tmpTPA[pArray].x > tmpTPA[pArray + 1].x) then
begin
//temp := tmpTPA[pArray].x;
//tmpTPA[pArray].x := tmpTPA[pArray + 1].x;
//tmpTPA[pArray + 1].x := temp;
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := False;
end;
end;
until (done);
end;
if not (dox) then
begin
repeat
done := True;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if (tmpTPA[pArray].y > tmpTPA[pArray + 1].y) then
begin
//temp := tmpTPA[pArray].y;
// tmpTPA[pArray].y := tmpTPA[pArray + 1].y;
//tmpTPA[pArray + 1].y := temp;
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := False;
end;
end;
until (done);
end;
end;
pArray := startpt - 1;
for temp := 0 to getarraylength(Result) - 1 do
begin
pArray := pArray + 1;
Result[temp] := tmpTPA[pArray];
end;
end;
{*******************************************************************************
function MdPtOfArray(var Slope: Extended; TheArray: array of TPoint): TPoint;
By: Boreas
Description: Returns MidPt of the rectangle that an array of tpoints covers. Not
nescessarily one of the tpoint in the array. Also sets the slope of the diagonal
of the rectangle to slope.
*******************************************************************************}
function MdPtOfArray(var Slope: Extended; TheArray: array of TPoint): TPoint;
var
ArrayLength, minx, miny, maxx, maxy: Integer;
tmpTPA: array of TPoint;
begin
ArrayLength := getarraylength(TheArray);
setarraylength(tmpTPA, ArrayLength);
tmpTPA := TheArray;
if not (ArrayLength = 1) then
tmpTPA := RearrangeTPA(TheArray, 0, ArrayLength - 1, True, True);
minx := tmpTPA[0].x;
maxx := tmpTPA[ArrayLength - 1].x;
tmpTPA := TheArray;
if not (ArrayLength = 1) then
tmpTPA := RearrangeTPA(TheArray, 0, ArrayLength - 1, False, True);
miny := tmpTPA[0].y;
maxy := tmpTPA[ArrayLength - 1].y;
if ArrayLength = 1 then
begin
Result := TheArray[0];
Slope := 1;
exit;
end;
Result.x := Round((maxx + minx) / 2)
Result.y := Round((maxy + miny) / 2)
if (maxx - minx) = 0 then
begin
slope := 150.0;
exit;
end;
if (maxy - miny) = 0 then
begin
slope := 0.0;
exit;
end;
Slope := ((maxy - miny) / (maxx - minx));
end;
{*******************************************************************************
function GetDoors: array of DoorProfile;
By: Boreas
Description: High level returns infomation about doors on minimap in an array
of door profile
*******************************************************************************}
function GetDoors: array of DoorProfile;
var
tmpAOTPA: array of array of TPoint;
ResultLength, pArray: Integer;
begin
tmpAOTPA := GetAllDoorPixels;
ResultLength := getarraylength(tmpAOTPA);
setarraylength(Result, ResultLength);
////////Added in V2///////
if ResultLength = 0 then Exit;
///////////////////////////
for pArray := 0 to ResultLength - 1 do
begin
Result[pArray].Points := tmpAOTPA[pArray];
Result[pArray].PixelCount := getarraylength(tmpAOTPA[pArray]);
Result[pArray].Color := getcolor(tmpAOTPA[pArray][0].x, tmpAOTPA[pArray][0].y);
Result[pArray].MidPoint := MdPtOfArray(Result[pArray].Slope, tmpAOTPA[pArray]);
end;
end;Here is test script
program New;
{.include srl/srl.scar}
var mydoors:array of doorprofile;
i,t:integer;
begin
t:=getsystemtime;
mydoors:=getdoors;
if (getsystemtime-t)>500 then
writeln('too slow');
writeln('time '+inttostr(getsystemtime-t)+'ms');
writeln('How many doors '+INTTostr(getarraylength(mydoors)));
//or i:=0 to getarraylength(mydoors)-1 do
//writeln(inttostr(mydoors[i].midpoint.x)+' '+inttostr(mydoors[i].midpoint.y));
end.Please test accuracy and speed. It should get the correct number of doors on the minimap (IE not mistake drop dots). If it takes more than 500ms for you guys (100-200 for me) then there is another idea I can add. Please test in places with different amount of doors, some diagonal doors (like in draynor), different amount of drop dots, and try it on a world where the door color is 233,205,217, or 241.
If anyone gets over 500ms, or gets a drop dot mistaken as a door, I have more work to do. Other than that, I don't see any other changes to be made.
Thankyou.