Boreas
03-28-2007, 04:08 AM
Will be adding. Check the change log and read again if needed.
Change Log
March 28 - basics, examples no explanation
May 6- Updated to reflect that it's in SRL 3.7 (should have done that earlier) and then updated to V2
get this (http://www.villavu.com/forum/showthread.php?t=6330) if you haven't already
EDIT May 28
Nielsie and The_Rs_Monkey pointed out lines 33 and 93 should be
if FindColorCircle(tmpx, tmpy, Color, mmcx, mmcy, 70) then
Please update this if you have SCAR 2.03 and SRL 3.7. Divi users can do the same or re-download once Freddy updates Divi's SRL.
EDIT
DoorProfiles V1 is already in SRL 3.7 . If you have DoorProfiles V1 already from either SRL 3.7 or from reading this tut before this edit (May 6th 2007), rename it to DoorProfiles1.scar. V2 (below) has a few failsafes for when there aren't doors around.
Save this to DoorProfiles.scar in you includes/SRL/SRL/core folder
V2
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- » Door Routines --//
//-----------------------------------------------------------------//
//V2- May 5th 2007- Added failsafes for when there are no doors
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,mm y2,0);
Length206:=getarraylength(Array206);
FindColorsTolerance(Array217,217,mmx1,mmy1,mmx2,mm y2,0);
Length217:=getarraylength(Array217);
FindColorsTolerance(Array233,233,mmx1,mmy1,mmx2,mm y2,0);
Length233:=getarraylength(Array233);
FindColorsTolerance(Array241,241,mmx1,mmy1,mmx2,mm y2,0);
Length241:=getarraylength(Array241);
RangeOfOthers206:=max(Length233,max(Length217,Leng th241))-min(Length233,min(Length217,Length241));
RangeOfOthers217:=max(Length233,max(Length206,Leng th241))-min(Length233,min(Length206,Length241));
RangeOfOthers233:=max(Length206,max(Length217,Leng th241))-min(Length206,min(Length217,Length241));
RangeOfOthers241:=max(Length233,max(Length217,Leng th206))-min(Length233,min(Length217,Length206));
MinOfRange:=min(RangeOfOthers206,min(RangeOfOthers 217,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=first)or(Color=217)or(Col or=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,mm y2,0);
Length206:=getarraylength(Array206);
FindColorsTolerance(Array217,217,mmx1,mmy1,mmx2,mm y2,0);
Length217:=getarraylength(Array217);
FindColorsTolerance(Array233,233,mmx1,mmy1,mmx2,mm y2,0);
Length233:=getarraylength(Array233);
FindColorsTolerance(Array241,241,mmx1,mmy1,mmx2,mm y2,0);
Length241:=getarraylength(Array241);
RangeOfOthers206:=max(Length233,max(Length217,Leng th241))-min(Length233,min(Length217,Length241));
RangeOfOthers217:=max(Length233,max(Length206,Leng th241))-min(Length233,min(Length206,Length241));
RangeOfOthers233:=max(Length206,max(Length217,Leng th241))-min(Length206,min(Length217,Length241));
RangeOfOthers241:=max(Length233,max(Length217,Leng th206))-min(Length233,min(Length217,Length206));
MinOfRange:=min(RangeOfOthers206,min(RangeOfOthers 217,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):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,tmpTPA3: array of tpoint;
tmpAOTPA: array of array of tpoint;
begin
DoorColor1:= GetDoorcolor;
DoorColor2:= GetSecondDoorColor(DoorColor1);
////////Added in V2///////
if (DoorColor1=DoorColor2) then
DoorColor1:=0;
if (DoorColor1=0) and (DoorColor2=0)then
exit;
///////////////////////////
tmpTPA1:=GetPixelsD(DoorColor1,mmx1,mmy1,mmx2,mmy2 ,0);
tmpTPA2:=GetPixelsD(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;
///////////////////////////
tmpAOTPA:=SplitTPA(tmpTPA3);
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);
////////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;
Run this near the lumby chicken pen, so that you can see the gate on the minimap. program New;
{.include Srl/srl.scar}
var
MyDoors: array of DoorProfile;
t,f:integer;
mytpa,mytpa2:array of tpoint;
TheGate: tpoint;
begin
SetupSRL;
t:=getsystemtime;
MyDoors:=GetDoors;
writeln(inttostr(getsystemtime-t)+' ms');
setarraylength(mytpa,getarraylength(mydoors));
for f:= 0 to getarraylength(MyDoors)-1 do
begin
MyTPA[f]:=MyDoors[f].MidPoint;
writeln(inttostr(mytpa[f].x)+','+ inttostr(mytpa[f].y));
end;
setarraylength(mytpa2,3);
MyTPA2:= RearrangeTPA(MyTPA,0,2,true,true);
MyTPA2:= RearrangeTPA(MyTPA,0,2,false,true);
TheGate:=MyTPA2[0];
mmouse(TheGate.x,TheGate.y,1,1);
end.
Run this in lumby castle
program New;
{.include Srl/srl.scar}
Var DebugCanvas,BmpCanvas:TCanvas;
procedure AddArray (WhichTPA:array of tpoint; WhichColor:integer);
var parray, arraylength:integer;
begin
arraylength:=getarraylength(whichtpa);
for parray:=0 to arraylength-1 do
bmpcanvas.pixels[whichtpa[parray].x-576+5,whichtpa[parray].y-9+5]:=WhichColor;
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,1 55,162)
end;
procedure StartMiniMapDebug;
Var bmpBlankMap:integer;
begin {
bmpBlankMap:= LoadBitmap(apppath+'test.bmp');
DisplayDebugImgWindow(160,167) //to show the canvas
DebugCanvas:=getdebugcanvas //gets the referance to the debug image and stores in that varaible
BmpCanvas:=GetBitmapCanvas(bmpBlankMap)//gets the regerance to the bmp and stores in that variable
BlankMapCanvas:=GetBitmapCanvas(bmpBlankMap);
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,1 55,162)
FreeBitmap(bmpBlankMap);
}
bmpBlankMap:= LoadBitmap(apppath+'test.bmp');
DisplayDebugImgWindow(160,167) //to show the canvas
DebugCanvas:=getdebugcanvas //gets the referance to the debug image and stores in that varaible
BmpCanvas:=GetBitmapCanvas(bmpBlankMap)//gets the regerance to the bmp and stores in that variable
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,1 55,162)
end;
var
MyDoors: array of DoorProfile;
t,f:integer;
begin
SetupSRL;
t:=getsystemtime;
MyDoors:=GetDoors;
writeln(inttostr(getsystemtime-t)+' ms');
StartMiniMapDebug;
for f:= 0 to getarraylength(MyDoors)-1 do
begin
cleardebug;
writeln('press f12');
repeat
wait(30);
until isfkeydown(12);
//StartMiniMapDebug;
//writeln(tPtArrayToStr(myAOTPA[f]));
writeln('press f11');
repeat
wait(30);
until isfkeydown(11);
//if MyDoors[f].slope>1.0 then//uncomment this line
//to only view vertical doors
AddArray(MyDoors[f].Points,16777215);
end;
end.
For history
V1
//-----------------------------------------------------------------//
//-- --//
//-- » 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,mm y2,0);
Length206:=getarraylength(Array206);
FindColorsTolerance(Array217,217,mmx1,mmy1,mmx2,mm y2,0);
Length217:=getarraylength(Array217);
FindColorsTolerance(Array233,233,mmx1,mmy1,mmx2,mm y2,0);
Length233:=getarraylength(Array233);
FindColorsTolerance(Array241,241,mmx1,mmy1,mmx2,mm y2,0);
Length241:=getarraylength(Array241);
RangeOfOthers206:=max(Length233,max(Length217,Leng th241))-min(Length233,min(Length217,Length241));
RangeOfOthers217:=max(Length233,max(Length206,Leng th241))-min(Length233,min(Length206,Length241));
RangeOfOthers233:=max(Length206,max(Length217,Leng th241))-min(Length206,min(Length217,Length241));
RangeOfOthers241:=max(Length233,max(Length217,Leng th206))-min(Length233,min(Length217,Length206));
MinOfRange:=min(RangeOfOthers206,min(RangeOfOthers 217,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(Col or=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,mm y2,0);
Length206:=getarraylength(Array206);
FindColorsTolerance(Array217,217,mmx1,mmy1,mmx2,mm y2,0);
Length217:=getarraylength(Array217);
FindColorsTolerance(Array233,233,mmx1,mmy1,mmx2,mm y2,0);
Length233:=getarraylength(Array233);
FindColorsTolerance(Array241,241,mmx1,mmy1,mmx2,mm y2,0);
Length241:=getarraylength(Array241);
RangeOfOthers206:=max(Length233,max(Length217,Leng th241))-min(Length233,min(Length217,Length241));
RangeOfOthers217:=max(Length233,max(Length206,Leng th241))-min(Length233,min(Length206,Length241));
RangeOfOthers233:=max(Length206,max(Length217,Leng th241))-min(Length206,min(Length217,Length241));
RangeOfOthers241:=max(Length233,max(Length217,Leng th206))-min(Length233,min(Length217,Length206));
MinOfRange:=min(RangeOfOthers206,min(RangeOfOthers 217,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);
tmpTPA1:=GetPixelsD(DoorColor1,mmx1,mmy1,mmx2,mmy2 ,0);
tmpTPA2:=GetPixelsD(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;
Change Log
March 28 - basics, examples no explanation
May 6- Updated to reflect that it's in SRL 3.7 (should have done that earlier) and then updated to V2
get this (http://www.villavu.com/forum/showthread.php?t=6330) if you haven't already
EDIT May 28
Nielsie and The_Rs_Monkey pointed out lines 33 and 93 should be
if FindColorCircle(tmpx, tmpy, Color, mmcx, mmcy, 70) then
Please update this if you have SCAR 2.03 and SRL 3.7. Divi users can do the same or re-download once Freddy updates Divi's SRL.
EDIT
DoorProfiles V1 is already in SRL 3.7 . If you have DoorProfiles V1 already from either SRL 3.7 or from reading this tut before this edit (May 6th 2007), rename it to DoorProfiles1.scar. V2 (below) has a few failsafes for when there aren't doors around.
Save this to DoorProfiles.scar in you includes/SRL/SRL/core folder
V2
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- » Door Routines --//
//-----------------------------------------------------------------//
//V2- May 5th 2007- Added failsafes for when there are no doors
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,mm y2,0);
Length206:=getarraylength(Array206);
FindColorsTolerance(Array217,217,mmx1,mmy1,mmx2,mm y2,0);
Length217:=getarraylength(Array217);
FindColorsTolerance(Array233,233,mmx1,mmy1,mmx2,mm y2,0);
Length233:=getarraylength(Array233);
FindColorsTolerance(Array241,241,mmx1,mmy1,mmx2,mm y2,0);
Length241:=getarraylength(Array241);
RangeOfOthers206:=max(Length233,max(Length217,Leng th241))-min(Length233,min(Length217,Length241));
RangeOfOthers217:=max(Length233,max(Length206,Leng th241))-min(Length233,min(Length206,Length241));
RangeOfOthers233:=max(Length206,max(Length217,Leng th241))-min(Length206,min(Length217,Length241));
RangeOfOthers241:=max(Length233,max(Length217,Leng th206))-min(Length233,min(Length217,Length206));
MinOfRange:=min(RangeOfOthers206,min(RangeOfOthers 217,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=first)or(Color=217)or(Col or=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,mm y2,0);
Length206:=getarraylength(Array206);
FindColorsTolerance(Array217,217,mmx1,mmy1,mmx2,mm y2,0);
Length217:=getarraylength(Array217);
FindColorsTolerance(Array233,233,mmx1,mmy1,mmx2,mm y2,0);
Length233:=getarraylength(Array233);
FindColorsTolerance(Array241,241,mmx1,mmy1,mmx2,mm y2,0);
Length241:=getarraylength(Array241);
RangeOfOthers206:=max(Length233,max(Length217,Leng th241))-min(Length233,min(Length217,Length241));
RangeOfOthers217:=max(Length233,max(Length206,Leng th241))-min(Length233,min(Length206,Length241));
RangeOfOthers233:=max(Length206,max(Length217,Leng th241))-min(Length206,min(Length217,Length241));
RangeOfOthers241:=max(Length233,max(Length217,Leng th206))-min(Length233,min(Length217,Length206));
MinOfRange:=min(RangeOfOthers206,min(RangeOfOthers 217,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):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,tmpTPA3: array of tpoint;
tmpAOTPA: array of array of tpoint;
begin
DoorColor1:= GetDoorcolor;
DoorColor2:= GetSecondDoorColor(DoorColor1);
////////Added in V2///////
if (DoorColor1=DoorColor2) then
DoorColor1:=0;
if (DoorColor1=0) and (DoorColor2=0)then
exit;
///////////////////////////
tmpTPA1:=GetPixelsD(DoorColor1,mmx1,mmy1,mmx2,mmy2 ,0);
tmpTPA2:=GetPixelsD(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;
///////////////////////////
tmpAOTPA:=SplitTPA(tmpTPA3);
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);
////////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;
Run this near the lumby chicken pen, so that you can see the gate on the minimap. program New;
{.include Srl/srl.scar}
var
MyDoors: array of DoorProfile;
t,f:integer;
mytpa,mytpa2:array of tpoint;
TheGate: tpoint;
begin
SetupSRL;
t:=getsystemtime;
MyDoors:=GetDoors;
writeln(inttostr(getsystemtime-t)+' ms');
setarraylength(mytpa,getarraylength(mydoors));
for f:= 0 to getarraylength(MyDoors)-1 do
begin
MyTPA[f]:=MyDoors[f].MidPoint;
writeln(inttostr(mytpa[f].x)+','+ inttostr(mytpa[f].y));
end;
setarraylength(mytpa2,3);
MyTPA2:= RearrangeTPA(MyTPA,0,2,true,true);
MyTPA2:= RearrangeTPA(MyTPA,0,2,false,true);
TheGate:=MyTPA2[0];
mmouse(TheGate.x,TheGate.y,1,1);
end.
Run this in lumby castle
program New;
{.include Srl/srl.scar}
Var DebugCanvas,BmpCanvas:TCanvas;
procedure AddArray (WhichTPA:array of tpoint; WhichColor:integer);
var parray, arraylength:integer;
begin
arraylength:=getarraylength(whichtpa);
for parray:=0 to arraylength-1 do
bmpcanvas.pixels[whichtpa[parray].x-576+5,whichtpa[parray].y-9+5]:=WhichColor;
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,1 55,162)
end;
procedure StartMiniMapDebug;
Var bmpBlankMap:integer;
begin {
bmpBlankMap:= LoadBitmap(apppath+'test.bmp');
DisplayDebugImgWindow(160,167) //to show the canvas
DebugCanvas:=getdebugcanvas //gets the referance to the debug image and stores in that varaible
BmpCanvas:=GetBitmapCanvas(bmpBlankMap)//gets the regerance to the bmp and stores in that variable
BlankMapCanvas:=GetBitmapCanvas(bmpBlankMap);
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,1 55,162)
FreeBitmap(bmpBlankMap);
}
bmpBlankMap:= LoadBitmap(apppath+'test.bmp');
DisplayDebugImgWindow(160,167) //to show the canvas
DebugCanvas:=getdebugcanvas //gets the referance to the debug image and stores in that varaible
BmpCanvas:=GetBitmapCanvas(bmpBlankMap)//gets the regerance to the bmp and stores in that variable
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,1 55,162)
end;
var
MyDoors: array of DoorProfile;
t,f:integer;
begin
SetupSRL;
t:=getsystemtime;
MyDoors:=GetDoors;
writeln(inttostr(getsystemtime-t)+' ms');
StartMiniMapDebug;
for f:= 0 to getarraylength(MyDoors)-1 do
begin
cleardebug;
writeln('press f12');
repeat
wait(30);
until isfkeydown(12);
//StartMiniMapDebug;
//writeln(tPtArrayToStr(myAOTPA[f]));
writeln('press f11');
repeat
wait(30);
until isfkeydown(11);
//if MyDoors[f].slope>1.0 then//uncomment this line
//to only view vertical doors
AddArray(MyDoors[f].Points,16777215);
end;
end.
For history
V1
//-----------------------------------------------------------------//
//-- --//
//-- » 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,mm y2,0);
Length206:=getarraylength(Array206);
FindColorsTolerance(Array217,217,mmx1,mmy1,mmx2,mm y2,0);
Length217:=getarraylength(Array217);
FindColorsTolerance(Array233,233,mmx1,mmy1,mmx2,mm y2,0);
Length233:=getarraylength(Array233);
FindColorsTolerance(Array241,241,mmx1,mmy1,mmx2,mm y2,0);
Length241:=getarraylength(Array241);
RangeOfOthers206:=max(Length233,max(Length217,Leng th241))-min(Length233,min(Length217,Length241));
RangeOfOthers217:=max(Length233,max(Length206,Leng th241))-min(Length233,min(Length206,Length241));
RangeOfOthers233:=max(Length206,max(Length217,Leng th241))-min(Length206,min(Length217,Length241));
RangeOfOthers241:=max(Length233,max(Length217,Leng th206))-min(Length233,min(Length217,Length206));
MinOfRange:=min(RangeOfOthers206,min(RangeOfOthers 217,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(Col or=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,mm y2,0);
Length206:=getarraylength(Array206);
FindColorsTolerance(Array217,217,mmx1,mmy1,mmx2,mm y2,0);
Length217:=getarraylength(Array217);
FindColorsTolerance(Array233,233,mmx1,mmy1,mmx2,mm y2,0);
Length233:=getarraylength(Array233);
FindColorsTolerance(Array241,241,mmx1,mmy1,mmx2,mm y2,0);
Length241:=getarraylength(Array241);
RangeOfOthers206:=max(Length233,max(Length217,Leng th241))-min(Length233,min(Length217,Length241));
RangeOfOthers217:=max(Length233,max(Length206,Leng th241))-min(Length233,min(Length206,Length241));
RangeOfOthers233:=max(Length206,max(Length217,Leng th241))-min(Length206,min(Length217,Length241));
RangeOfOthers241:=max(Length233,max(Length217,Leng th206))-min(Length233,min(Length217,Length206));
MinOfRange:=min(RangeOfOthers206,min(RangeOfOthers 217,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);
tmpTPA1:=GetPixelsD(DoorColor1,mmx1,mmy1,mmx2,mmy2 ,0);
tmpTPA2:=GetPixelsD(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;