Simba Code:
program Galileo;
{.include SRL/SRL.scar}
{.include SRL/SRL/misc/debug.scar}
//{$LOADLIB GalileoProjekti.dll}
const
GALILEO_PATH_MAP = AppPath + '/Includes/SRL/SRL/galileomap.bmp';
GALILEO_PATH_WALKINGMAP = AppPath + '/Includes/SRL/SRL/galileowalkingmap.bmp';
GALILEO_WALKABLECOLOR = 16711680;
GALILEO_TOL_MAX = 0.6;
GALILEO_TOL_MIN = 0.4;
GALILEO_TOL_STEP = 0.1;
GALILEO_FAIL_MAX = 120;
GALILEO_FAIL_MIN = 60;
GALILEO_FAIL_STEP = 20;
var
Galileo_Loaded: boolean;
Galileo_Worldmap: Array of Array of Array of Integer;
function Galileo_MakeColorBoxEx(bmp, x1, y1: integer): Array of Integer; //[0]=Red [1]=Green [2]=Blue
var
x, y: integer;
R, G, B: integer;
begin
SetLength(Result, 3);
for x := x1 to (x1 + 5) do
for y := y1 to (y1 + 5) do
begin
try
ColorToRGB(FastGetPixel(bmp, x, y), R, G, B);
Result[0] := Result[0] + R;
Result[1] := Result[1] + G;
Result[2] := Result[2] + B;
except
writeln('ColorToRGB exception: '+inttostr(x)+', '+inttostr(y));
end;
end;
end;
function Galileo_MakeColorBox(x1, y1: integer): Array of Integer;
var
bmp: integer;
begin
CopyClientToBitmap(bmp, x1, y1, x1+5, y1+5);
Result := Galileo_MakeColorBoxEx(bmp, x1, y1);
FreeBitmap(bmp);
end;
function Galileo_ColorBoxesMatch(B1, B2: Array of Integer; tol: extended): boolean;
begin
if (B1[0] >= Round(B2[0]*(1-tol))) and (B1[0] <= Round(B2[0]*(1+tol))) then
if (B1[1] >= Round(B2[1]*(1-tol))) and (B1[1] <= Round(B2[1]*(1+tol))) then
if (B1[2] >= Round(B2[2]*(1-tol))) and (B1[2] <= Round(B2[2]*(1+tol))) then
begin
Result := True;
Exit;
end;
end;
function Galileo_BitmapToMap(bmp: integer): Array of Array of Array of Integer;
var
X, Y, HighX, HighY, timer: integer;
begin
timer := getsystemtime;
GetBitmapSize(bmp, HighX, HighY);
HighX := Floor(HighX / (5.0));
HighY := Floor(HighY / (5.0));
for X := 0 to HighX-1 do
begin
SetLength(Result, HighX);
for Y := 0 to HighY-1 do
begin
SetLength(Result[X], HighY);
Result[X][Y] := Galileo_MakeColorBoxEx(bmp, X*5, Y*5);
end;
end;
end;
function Galileo_GatherMinimap: Array of Array of Array of Integer;
var
bmp: integer;
begin
CopyClientToBitmap(bmp, MMCX-50, MMCY-50, MMCX+50, MMCY+50);
Result := Galileo_BitmapToMap(bmp);
FreeBitmap(bmp);
end;
function Galileo_FindMapInMapExx(LargeMap, SmallMap: Array of Array of Array of Integer; tol: extended; MaxFails: integer): TPoint;
var
x, y, HighX, HighY: integer;
xx, yy: integer;
Matching: integer;
begin
Result := Point(-1, -1);
HighX := High(LargeMap);
HighY := High(LargeMap[0]);
for x := 0 to HighX do
for y := 0 to HighY do
if Galileo_ColorBoxesMatch(LargeMap[x][y], SmallMap[0][0], tol) then
begin
Matching := 0;
try
// top left matches, let's compare the others
for xx := 0 to 19 do
for yy := 0 to 19 do
if Galileo_ColorBoxesMatch(LargeMap[x+xx][y+yy], SmallMap[xx][yy], tol) then
Inc(Matching);
//writeln('matching: '+inttostr(matching));
if Matching >= (400 - MaxFails) then // 20*20 = 400
begin
Result.X := x + 10; // +10 cause we want the center
Result.Y := y + 10;
Exit;
end;
except
end;
end;
end;
function Galileo_FindMapInMapLoop(SmallMap, LargeMap: Array of Array of Array of Integer; mintol, maxtol, tolstep: extended; minfails, maxfails, failsstep: integer): TPoint;
var
fails: integer;
tol: extended;
begin
tol := mintol;
while (tol < maxtol) do
begin
fails := minfails;
while (fails < maxfails) do
begin
Result := Galileo_FindMapInMapExx(LargeMap, SmallMap, tol, fails);
if (Result.X > 0) and (Result.Y > 0) then
Exit;
fails := fails + failsstep;
end;
tol := tol + tolstep;
end;
end;
function Galileo_FindPosition(var X, Y: integer): boolean;
var
P: TPoint;
Minimap: Array of Array of Array of Integer;
t, bmp: integer;
begin
t := getsystemtime;
Minimap := Galileo_GatherMinimap;
t := getsystemtime - t;
writeln('[GALILEO] Minimap built in '+inttostr(t)+' ms.');
if (not Galileo_Loaded) then
begin
t := getsystemtime;
bmp := LoadBitmap(GALILEO_PATH_MAP);
Galileo_Worldmap := Galileo_BitmapToMap(bmp);
FreeBitmap(bmp);
Galileo_Loaded := True;
t := getsystemtime - t;
writeln('[GALILEO] Worldmap built in '+inttostr(t)+' ms.');
end;
t := getsystemtime;
P := Galileo_FindMapInMapLoop(Minimap, Galileo_Worldmap, GALILEO_TOL_MIN, GALILEO_TOL_MAX, GALILEO_TOL_STEP,
GALILEO_FAIL_MIN, GALILEO_FAIL_MAX, GALILEO_FAIL_STEP);
if (P.X > 0) and (P.Y > 0) then
begin
Result := True;
X := P.X;
Y := P.Y;
end;
t := getsystemtime - t;
writeln('[GALILEO] Positioning finished in '+inttostr(t)+' ms. Result = '+booltostr(Result)+', Location = ('+inttostr(x)+', '+inttostr(y)+')');
end;
{ =============================================================================]
G A L I L E O
T R A V E L E R
{ =============================================================================}
type
T2DBooleanArray = Array of Array of Boolean;
var
Galileo_WalkingMap: T2DBooleanArray;
function Galileo_BuildWalkingMap(ColouredMapPath: string; WalkableColor: integer): T2DBooleanArray;
var
bmp, x, y, h, w: integer;
i: integer;
C: T2DIntegerArray;
begin
bmp := LoadBitmap(ColouredMapPath);
GetBitmapSize(bmp, w, h);
w := Floor(w / 5.0);
h := Floor(h / 5.0);
SetLength(Result, w);
for x := 0 to w - 1 do
begin
SetLength(Result[x], h);
for y := 0 to h - 1 do
begin
C := GetBitmapAreaColors(bmp, x*5, y*5, (x+1)*5, (y+1)*5);
for i := 0 to high(C) do
if InIntArray(C[i], WalkableColor) then
begin
Result[x][y] := True;
Break;
end;
end;
end;
Writeln('[GALILEO] Walkingmap dimension = '+inttostr(w)+' x '+inttostr(h));
FreeBitmap(bmp);
end;
procedure Galileo_LoadWalking;
begin
Galileo_WalkingMap := Galileo_BuildWalkingMap(GALILEO_PATH_WALKINGMAP, GALILEO_WALKABLECOLOR);
end;
function Galileo_FindPathEx(Start, Destination: TPoint; var TPA: TPointArray): T2DBooleanArray;
var
Current: TPoint;
Distances: TExtendedArray;
modx, mody: TIntegerArray;
Possible: TBooleanArray;
i, Best, L: integer;
begin
SetLength(Distances, 8);
SetLength(Possible, 8);
modx := [-1, -1, -1, 0, 0, 1, 1, 1];
mody := [-1, 0, 1, -1, 1, -1, 0, 1];
Current := Start;
TPA := [Start];
while Current <> Destination do
begin
for i := 0 to 7 do
begin
Distances[i] := hypot(Abs(Destination.x - Current.x - modx[i]), Abs(Destination.y - Current.y - mody[i]));
try
if (Galileo_WalkingMap[Current.x + modx[i]][Current.y + mody[i]] = True) then
Possible[i] := not PointInTPA(Point(Current.x + modx[i], Current.y + mody[i]), TPA)
else
Possible[i] := False;
except
Possible[i] := False;
end;
end;
for i := 0 to 7 do
if Possible[i] then
begin
Best := i;
Break;
end;
for i := 0 to 7 do
if Distances[i] < Distances[Best] then
begin
//writeln('Distances['+inttostr(i)+'] < Distances['+IntToStr(Best)+']');
if Possible[i] then
begin
Best := i;
//Writeln(' -> Also possible');
end;// else
//Writeln(' -> ...but not possible');
end;
L := length(TPA);
Current := Point(TPA[L-1].x + modx[Best], TPA[L-1].y + mody[Best]);
SetLength(TPA, L+1);
TPA[L] := Current;
//Writeln('Current = ('+inttostr(Current.x)+', '+inttostr(Current.y)+')');
if Length(Result) < (Current.x + 1)then
SetLength(Result, Current.x + 1);
if Length(Result[Current.x]) < (Current.y + 1) then
SetLength(Result[Current.x], Current.y + 1);
Result[Current.x][Current.y] := True;
end;
end;
function Galileo_FindPath(Start, Destination: TPoint): TPointArray;
var
Booleans: T2DBooleanArray;
t: integer;
begin
Galileo_LoadWalking;
t := getsystemtime;
Booleans := Galileo_FindPathEx(Start, Destination, Result);
t := getsystemtime - t;
Writeln('[GALILEO] Path calculated in '+inttostr(t)+' ms.');
end;
{==============================================================================]
DEBUGGING
{==============================================================================}
procedure Galileo_DebugPath(Start, Destination: TPoint);
var
bPath: T2DBooleanArray;
Path: TPointArray;
x, y, bmp, w, h: integer;
begin
Galileo_LoadWalking;
bPath := Galileo_FindPathEx(Start, Destination, Path);
bmp := LoadBitmap(GALILEO_PATH_MAP);
GetBitmapSize(bmp, w, h);
for x := 0 to High(Galileo_WalkingMap) do
for y := 0 to High(Galileo_WalkingMap[x]) do
begin
if Galileo_WalkingMap[x][y] then
RectangleBitmap(bmp, IntToBox(x*5, y*5, (x+1)*5, (y+1)*5), clBlue);
try
if bPath[x][y] then
RectangleBitmap(bmp, IntToBox(x*5, y*5, (x+1)*5, (y+1)*5), clRed);
except
end;
end;
DebugBitmap(bmp);
FreeBitmap(bmp);
end;
function Galileo_WalkTo(x, y: integer): boolean;
var
TPA: TPointArray;
I, H, sx, sy: integer;
cx, cy: integer;
begin
if not Galileo_FindPosition(sx, sy) then
Exit;
TPA := Galileo_FindPath(Point(sx, sy), Point(x, y));
cx := TPA[0].x;
cy := TPA[0].y;
H := High(TPA);
while (not Result) do
for I := H downto 0 do
if Distance(cx, cy, TPA[I].X, TPA[I].Y) < 7 then
begin
MouseFlag(MMCX - (cx - TPA[I].X)*5, MMCY - (cy - TPA[I].Y)*5, 0, 0, 2);
cx := TPA[I].x;
cy := TPA[I].y;
Result := I = 0;
if Result then
Break;
end;
end;
begin
SetupSRL;
Galileo_WalkTo(37, 16);
//Galileo_DebugPath(Point(131, 33), Point(37, 16));
end.