SCAR Code:
program New;
{.include SRL/SRL.scar}
var doorcolor:integer;
var skippingarray:tboxarray;
AOTPA:array of TpointArray;
vx,f,vy:integer;
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 FindColor(tmpx,tmpy,Color,mmx1,mmy1,mmx2,mmy2) 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 tPtArrayToStr(newTPoint: TPointArray): string;
var
i: Integer;
begin
for i:=0 to GetArrayLength(newTPoint)-1 do
begin
Result := Result + IntToStr(newTPoint[i].x) + ',' +
IntToStr(newTPoint[i].y);
if (not (i = (GetArrayLength(newTPoint) - 1))) then
Result := Result + ' ';
end;
end;
function BoxArrayToArrayOfTPA(Color:integer; Boxes:array of TBox): array of TPointArray;
var i:integer;
begin
setarraylength(result,getarraylength(boxes));
for i:=0 to GetArrayLength(Boxes)-1 do
FindColorsTolerance(result[i],Color,Boxes[i].x1,Boxes[i].y1,Boxes[i].x2,Boxes[i].y2,0);
end;
procedure DisplayPicture(TheBox:tbox);
var
DebugCanvas, ClientCanvas: TCanvas;
w, h, bmp: Integer;
begin
w := Thebox.x2 - Thebox.x1;
h := Thebox.y2 - Thebox.y1;
ActivateClient;
DisplayDebugImgWindow(w, h);
DebugCanvas := GetDebugCanvas;
ClientCanvas := GetClientCanvas;
SafeCopyCanvas(ClientCanvas, DebugCanvas, TheBox.x1,TheBox.y1,TheBox.x2,TheBox.y2, 0, 0, w, h);
//bmp := BitmapFromString(w, h, '');
//CopyClientToBitmap(bmp,Thebox.x1, Thebox.y1, Thebox.x1 + w, Thebox.y1 + h);
//DisplayDebugImgWindow(w, h);
//CopyCanvas(GetBitmapCanvas(bmp), GetDebugCanvas, TheBox.x1,TheBox.y1,TheBox.x2,TheBox.y2, 0, 0, w, h);
end;
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 SurroundBox(px,py:integer):Tbox;
var Inner,Outer:Tbox;
PointColor,dx,dy:integer;
begin
PointColor:=GetColor(px,py);
Inner.x1:=px;
Inner.y1:=py;
Inner.x2:=px;
Inner.y2:=py;
Outer.x1:=px-5;
Outer.y1:=py-5;
Outer.x2:=px+5;
Outer.y2:=py+5; {
repeat
// Outer.x1:=Outer.x1-1;
Inner.x1:=Inner.x1-1;
//writeln('test3');
until (not(FindColorSkipBox(dx,dy,PointColor,Outer.x1,Outer.y1,Inner.x1,Outer.y2,Inner)));
//writeln('test2');
repeat
// Outer.Y1:=Outer.Y1-1;
Inner.Y1:=Inner.y1-1;
until (not(FindColorSkipBox(dx,dy,PointColor,Outer.x1,Outer.y1,Outer.x2,Outer.y2,Inner)));
//writeln('test1');
repeat
//Outer.x2:=Outer.x2+1;
Inner.x2:=Inner.x2+1;
until (not(FindColorSkipBox(dx,dy,PointColor,Outer.x1,Outer.y1,Outer.x2,Outer.y2,Inner)));
// writeln('test1');
repeat
// Outer.y2:=Outer.y2+1;
Inner.y2:=Inner.y2+1;
until (not(FindColorSkipBox(dx,dy,PointColor,Outer.x1,Outer.y1,Outer.x2,Outer.y2,Inner)));
//writeln('test1');
Result:=inner; }result:=outer;
end;
var arraylength,i,t:integer;
tpa:tpointarray;
function MidPointOfLine(TheArray:array of Tpoint):Tpoint;
//var tmpresult:T:integer;
begin
if getarraylength(thearray)>1 then
result:=TheArray[round(getarraylength(TheArray)/2)-1];
if getarraylength(thearray)=1 then result:=thearray[0];
end;
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 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 FindDoorColor: Integer;
var
arRoughDoorColors, arFineDoorColors: TPointArray;
i, bmpRedDot: Integer;
begin
bmpRedDot := BitmapFromString(2, 2, 'FE2020FC0606FC0606F10000');
FindColorsSpiralTolerance(MMCX, MMCY, arRoughDoorColors, 241, MMX1, MMY1, MMX2, MMY2, 20);
for i := 0 to GetArrayLength(arRoughDoorColors) - 1 do
begin
FindColorsSpiralTolerance(arRoughDoorColors[i].x, arRoughDoorColors[i].y, arFineDoorColors, 241, arRoughDoorColors[i].x - 4, arRoughDoorColors[i].y - 4, arRoughDoorColors[i].x + 4, arRoughDoorColors[i].y + 4, 20);
if(GetArrayLength(arFineDoorColors) = 3)and
(not(FindBitmapToleranceIn(bmpRedDot, x, y, arRoughDoorColors[i].x - 4, arRoughDoorColors[i].y - 4, arRoughDoorColors[i].x + 4, arRoughDoorColors[i].y + 4, 20)))then
begin
Result := GetColor(arRoughDoorColors[i].x, arRoughDoorColors[i].y);
Writeln('Found possible door at x = ' + IntToStr(arRoughDoorColors[i].x) + ' y = ' + IntToStr(arRoughDoorColors[i].y));
FreeBitmap(bmpRedDot);
Exit;
end
end;
FreeBitmap(bmpRedDot);
Writeln('Door color not found.');
end;
var tpa2,tpa3:array of tpoint;
begin
SetupSRL;
t:=getsystemtime;
doorcolor:=finddoorcolor;
// DisplayPicture(657,120,671,129);
//mybox:=Surroundbox(myx,myy);
//setarraylength(skippingarray,1);
//skippingarray[0].x1:=0;
//skippingarray[0].y1:=0;
//skippingarray[0].x2:=1;
//skippingarray[0].y2:=1;
//arraylength:=1;
repeat {566,6,730,163}
if FindColorSkipBoxArray(vx,vy,DoorColor,mmx1,mmy1,mmx2,mmy2,skippingarray) then
begin
//writeln('found');
//writeln(inttostr(arraylength));
//arraylength:= getarraylength(skippingarray);
arraylength:=arraylength+1;
setarraylength(skippingarray,arraylength);
skippingarray[arraylength-1]:= Surroundbox(vx,vy);
//writeln('test1');
end;
//writeln(inttostr(arraylength));
wait(1);
until ((isfkeydown(11)) or (not(FindColorSkipBoxArray(vx,vy,DoorColor,mmx1,mmy1,mmx2,mmy2,skippingarray))));
//writeln('done');
{ repeat
repeat
wait(1000);
until isfkeydown(12);
i:=i+1;
DisplayPicture(Skippingarray[i]);
repeat
wait(1000);
until isfkeydown(11);
until i=(arraylength-1); }
AOTPA:=BoxArrayToArrayOfTPA(doorColor,Skippingarray)
AOTPA:=ignoredropdots(aotpa);
setarraylength(TPA,getarraylength(AOTPA));
for f:= 0 to getarraylength(AOTPA)-1 do
TPA[f]:=MidPointOfLine(AOTPA[f]);
//for f:= 0 to getarraylength(AOTPA)-1 do
//writeln(tPtArrayToStr(AOTPA[f]));
for f:= 0 to getarraylength(tpa)-1 do
writeln(inttostr(tpa[f].x)+','+inttostr(tpa[f].y));
end.