//-----------------------------------------------------------------//
//-- 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: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=233)or(Color=241))) then
begin
if FindColorCircle(tmpx,tmpy,Color,70,mmcx,mmcy) 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)));
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=first)or(Color=217)or(Color=233)or(Color=241))) then
begin
if FindColorCircle(tmpx,tmpy,Color,70,mmcx,mmcy) 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)));
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):boolean;
var color:integer;
begin
color:=getcolor(TP.x,TP.y);
case color of
206:
begin
if (getcolor(TP.x,TP.y-1)=233)
or (getcolor(TP.x-1,TP.y)=241)
or (getcolor(TP.x-2,TP.y+1)=217)then
result:=true;
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 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 IgnoreDropDots(TheList:array of array of tpoint):array of array of tpoint;
var
pTo,pFrom:integer;
pList:integer;
begin
result:=TheList;
for pList :=0 to getarraylength(result)-1 do
begin
pTo:=0-1;
pFrom:=0;
for pFrom:=0 to getarraylength(result[pList])-1 do
begin
if not(IsTPointInDropDot(result[pList][pFrom])) then
begin
pTo:=pTo+1;
result[pList][pTo]:=result[pList][pFrom];
end;
end;
setarraylength(result[pList],pto+1);
end;
pTo:=0-1;
pFrom:=0;
for pFrom:=0 to getarraylength(result)-1 do
begin
if not(getarraylength(result[pFrom])=0) then
begin
pTo:=pTo+1;
result[pTo]:=result[pFrom];
end;
end;
// writeln(inttostr(pto));
setarraylength(result,pto+1);
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: array of tpoint;
tmpAOTPA: array of array of tpoint;
begin
DoorColor1:= GetDoorcolor;
DoorColor2:= GetSecondDoorColor(DoorColor1);
FindColorsTolerance(tmpTPA1, DoorColor1, mmx1, mmy1, mmx2, mmy2, 0);
FindColorsTolerance(tmpTPA2, DoorColor2, mmx1, mmy1, mmx2, mmy2, 0);
if not(DoorColor1=DoorColor2) then
tmpTPA1:=AddTPA(tmpTPA1,tmpTPA2);
tmpAOTPA:=SplitTPA(tmpTPA1);
result:=IgnoreDropDots(tmpAOTPA);
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);
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;
