SCAR Code:
program New;
{const
MMCY = 88;
MMXY = MMCY;
MMX1 = 0;
MMY1 = MMX1;
MMX2 = 175;
MMY2 = MMX2;}
{.include srl/srl/core/globals.scar}
var
Box: TBox;
{function GetOutline(Color, MMX1, MMY1, MMX2, MMY2: Integer): TCanvas;
var
Canvas: TCanvas;
I, II, DistX, DistY, BeginX, BeginY: Integer;
Bool: Boolean;
begin
DistX := MMX2 - MMX1 + 2;
DistY := MMY2 - MMY1 + 2;
Result := GetBitmapCanvas(BitmapFromString(DistX, DistY, ''));
Canvas := GetBitmapCanvas(BitmapFromString(DistX, DistY, ''));
SafeCopyCanvas(GetClientCanvas, Canvas, MMX1, MMY1, MMX2, MMY2,
1, 1, DistX - 1, DistY - 1);
for I := 1 to DistX - 1 do
begin
for II := 1 to DistY - 1 do
begin
if Canvas.Pixels[I, II] = Color then
begin
BeginX := I;
BeginY := II;
II := II + 1;
Bool := false;
while Canvas.Pixels[I, II] = Color do
begin
Bool := true;
II := II + 1;
end;
II := II - 1;
if Bool then
begin
Result.Pixels[BeginX, BeginY] := ClRed;
Result.Pixels[I, II] := ClRed;
end;
end;
end;
end;
for I := 1 to DistY - 1 do
begin
for II := 1 to DistX - 1 do
begin
if Canvas.Pixels[II, I] = Color then
begin
BeginX := II;
BeginY := I;
II := II + 1;
Bool := false
while Canvas.Pixels[II, I] = Color do
begin
Bool := true;
II := II + 1;
end;
II := II - 1;
if Bool then
begin
Result.Pixels[BeginX, BeginY] := ClRed;
Result.Pixels[II, I] := ClRed;
end;
end;
end;
end;
SafeCopyCanvas(Result, GetDebugCanvas, 0, 0, 177, 177, 0, 0, 177, 177);
end;
procedure NextPoint(var X, Y: Integer; LastX, LastY,
Number: Integer);
begin
case Number of
0:
begin
X := LastX - 1;
Y := LastY - 1;
end;
1:
begin
X := LastX;
Y := LastY - 1;
end;
2:
begin
X := LastX + 1;
Y := LastY - 1;
end;
3:
begin
X := LastX + 1;
Y := LastY;
end;
4:
begin
X := LastX + 1;
Y := LastY + 1;
end;
5:
begin
X := LastX;
Y := LastY + 1;
end;
6:
begin
X := LastX - 1;
Y := LastY + 1;
end;
7:
begin
X := LastX - 1;
Y := LastY;
end;
end;
end;
procedure SetGreatest(var N, S, E, W: Integer; X, Y: Integer);
begin
if Y < N then
begin
N := Y;
end;
if Y > S then
begin
S := Y;
end;
if X < W then
begin
W := X;
end;
if X > E then
begin
E := X;
end;
end;
function GetEncloased(Canvas: TCanvas; MMX1, MMY1, MMX2,
MMY2: Integer): TBox;
var
I, II, DistX, DistY, X, Y, Point, Last, Dist,
NewDist, N, S, E, W, BeginX, BeginY: Integer;
Color: Integer;
begin
Dist := -1;
NewDist := 0;
DistX := MMX2 - MMX1 + 2;
DistY := MMY2 - MMY1 + 2;
Last := -1;
Point := -1;
Color := 16777215;
for I := 1 to DistX - 1 do
begin
for II := 1 to DistY - 1 do
begin
if Canvas.Pixels[I, II] = ClRed then
begin
BeginX := I;
BeginY := II;
N := BeginY;
S := BeginY;
E := BeginX;
W := BeginX;
Canvas.Pixels[I, II] := Color;
while Point < 8 do
begin
SafeCopyCanvas(Canvas, GetDebugCanvas, 0, 0, 177, 177, 0, 0, 177, 177);
Point := Point + 1;
NextPoint(X, Y, I, II, Point);
if Canvas.Pixels[X, Y] = ClRed then
begin
SetGreatest(N, S, E, W, X, Y);
I := X;
II := Y;
Point := -1;
Canvas.Pixels[X, Y] := Color;
end;
end;
NewDist := Distance(E, N, W, S);
if NewDist > Dist then
begin
Result.Y1 := N;
Result.Y2 := S;
Result.X1 := W;
Result.X2 := E;
Dist := NewDist;
end;
Point := -1;
I := BeginX;
II := BeginY;
WriteLn('(' + IntToStr(E) + ',' + IntToStr(N) + ')(' + IntToStr(W) + ',' + IntToStr(S) + ')');
SafeCopyCanvas(Canvas, GetDebugCanvas, 0, 0, 175, 175, 0, 0, 175, 175);
end;
end;
end;
end;
function FindRoad(var Box: TBox; Color: Integer): Boolean;
var
TempBox: TBox;
Canvas: TCanvas;
begin
ClearDebug;
DisplayDebugImgWindow(177, 177);
SafeDrawBitmap(BitmapFromString(177, 177, ''), GetDebugCanvas, 0, 0);
Canvas := GetOutline(Color, MMX1, MMY1, MMX2, MMY2);
TempBox := GetEncloased(Canvas, MMX1, MMY1, MMX2, MMY2);
Result := false;
if Distance(TempBox.X1, TempBox.Y1, TempBox.X2, TempBox.Y2) > 63 then
begin
Box := TempBox;
Result := true;
end;
WriteLn(IntToStr(Box.X1) + ',' + IntToStr(Box.Y1) + ','+ IntToStr(Box.X2) + ',' + IntToStr(Box.Y2));
end; }
function GetOutline(Color, MMX1, MMY1, MMX2, MMY2: Integer): TCanvas;
var
Canvas: TCanvas;
I, II, DistX, DistY, BeginX, BeginY: Integer;
Bool: Boolean;
begin
DistX := MMX2 - MMX1 + 2;
DistY := MMY2 - MMY1 + 2;
Result := GetBitmapCanvas(BitmapFromString(DistX, DistY, ''));
Canvas := GetBitmapCanvas(BitmapFromString(DistX, DistY, ''));
SafeCopyCanvas(GetClientCanvas, Canvas, MMX1, MMY1, MMX2, MMY2,
1, 1, DistX - 1, DistY - 1);
for I := 1 to DistX - 1 do
begin
for II := 1 to DistY - 1 do
begin
if Canvas.Pixels[I, II] = Color then
begin
BeginX := I;
BeginY := II;
II := II + 1;
Bool := false;
while Canvas.Pixels[I, II] = Color do
begin
Bool := true;
II := II + 1;
end;
II := II - 1;
if Bool then
begin
Result.Pixels[BeginX, BeginY] := ClRed;
Result.Pixels[I, II] := ClRed;
end;
end;
end;
end;
for I := 1 to DistY - 1 do
begin
for II := 1 to DistX - 1 do
begin
if Canvas.Pixels[II, I] = Color then
begin
BeginX := II;
BeginY := I;
II := II + 1;
Bool := false
while Canvas.Pixels[II, I] = Color do
begin
Bool := true;
II := II + 1;
end;
II := II - 1;
if Bool then
begin
Result.Pixels[BeginX, BeginY] := ClRed;
Result.Pixels[II, I] := ClRed;
end;
end;
end;
end;
end;
procedure NextPoint(var X, Y: Integer; LastX, LastY,
Number: Integer);
begin
case Number of
0:
begin
X := LastX - 1;
Y := LastY - 1;
end;
1:
begin
X := LastX;
Y := LastY - 1;
end;
2:
begin
X := LastX + 1;
Y := LastY - 1;
end;
3:
begin
X := LastX + 1;
Y := LastY;
end;
4:
begin
X := LastX + 1;
Y := LastY + 1;
end;
5:
begin
X := LastX;
Y := LastY + 1;
end;
6:
begin
X := LastX - 1;
Y := LastY + 1;
end;
7:
begin
X := LastX - 1;
Y := LastY;
end;
end;
end;
procedure SetGreatest(var N, S, E, W: Integer; X, Y: Integer);
begin
if Y < N then
begin
N := Y;
end;
if Y > S then
begin
S := Y;
end;
if X < W then
begin
W := X;
end;
if X > E then
begin
E := X;
end;
end;
function GetEncloased(Canvas: TCanvas; MMX1, MMY1, MMX2,
MMY2: Integer): TBox;
var
I, II, DistX, DistY, X, Y, Point, Last, Dist,
NewDist, N, S, E, W, BeginX, BeginY: Integer;
Color: Integer;
begin
Dist := -1;
NewDist := 0;
DistX := MMX2 - MMX1 + 2;
DistY := MMY2 - MMY1 + 2;
Last := -1;
Point := -1;
Color := 16777215;
for I := 1 to DistX - 1 do
begin
for II := 1 to DistY - 1 do
begin
if Canvas.Pixels[I, II] = ClRed then
begin
BeginX := I;
BeginY := II;
N := BeginY;
S := BeginY;
E := BeginX;
W := BeginX;
Canvas.Pixels[I, II] := Color;
while Point < 8 do
begin
Point := Point + 1;
NextPoint(X, Y, I, II, Point);
if Canvas.Pixels[X, Y] = ClRed then
begin
SetGreatest(N, S, E, W, X, Y);
I := X;
II := Y;
Point := -1;
Canvas.Pixels[X, Y] := Color;
end;
end;
NewDist := Distance(E, N, W, S);
if NewDist > Dist then
begin
Result.Y1 := N;
Result.Y2 := S;
Result.X1 := W;
Result.X2 := E;
Dist := NewDist;
end;
Point := -1;
I := BeginX;
II := BeginY;
end;
end;
end;
end;
function FindRoad(var Box: TBox; Color: Integer): Boolean;
var
TempBox: TBox;
Canvas: TCanvas;
begin
Canvas := GetOutline(Color, MMX1, MMY1, MMX2, MMY2);
TempBox := GetEncloased(Canvas, MMX1, MMY1, MMX2, MMY2);
Result := false;
if Distance(TempBox.X1, TempBox.Y1, TempBox.X2, TempBox.Y2) > 63 then
begin
Box := TempBox;
Box.X1 := Box.X1 + MMX1 - 1;
Box.Y1 := Box.Y1 + MMY1 - 1;
Box.X2 := Box.X2 + MMX1 - 1;
Box.Y2 := Box.Y2 + MMY1 - 1;
Result := true;
end;
end;
begin
end.