Skip to content

Commit

Permalink
[API] + OSM.NetworkRequest.pas, more smart ordering in TNetworkReques…
Browse files Browse the repository at this point in the history
…tQueue. Method SetCurrentViewRect allows to set current viewport of a map so that extraction of queued tiles first looks for those in this area. This removed time lag before current view area is fully downloaded and shown.

Demo:
+ Uses this new feature; some comments added on it and also on demo logging that causes visual glitches
  • Loading branch information
Fr0sT-Brutal committed Oct 4, 2021
1 parent 5a5513f commit 9f6e2dd
Show file tree
Hide file tree
Showing 3 changed files with 70 additions and 11 deletions.
5 changes: 5 additions & 0 deletions Demo/MainUnit.pas
Original file line number Diff line number Diff line change
Expand Up @@ -312,7 +312,12 @@ procedure TMainForm.mMapDrawTile(Sender: TMapControl; TileHorzNum, TileVertNum:
1: NetRequest.RequestProps.Proxy := SystemProxy;
2: NetRequest.RequestProps.Proxy := eProxyAddr.Text;
end;
// Set current view area of the map so that tiles inside it will be downloaded first.
// This could be done in map's OnScroll event as well
NetRequest.SetCurrentViewRect(Sender.ViewRect);
NetRequest.RequestTile(Tile);
// ! Demo logging. Adds visual glitch when doing fast panning so disable it
// to get smooth performance.
Log(Format('Queued request from inet %s', [TileToStr(Tile)]));
end
else
Expand Down
2 changes: 1 addition & 1 deletion Source/OSM.MapControl.pas
Original file line number Diff line number Diff line change
Expand Up @@ -324,7 +324,7 @@ TMapControl = class(TScrollBox)
property OnSelectionBox: TOnSelectionBox read FOnSelectionBox write FOnSelectionBox;
end;

// Like Client<=>Screen
//~ Like Client<=>Screen

// Convert absolute map coords to a point inside a viewport having given top-left point
function ToInnerCoords(const StartPt, Pt: TPoint): TPoint; overload; inline;
Expand Down
74 changes: 64 additions & 10 deletions Source/OSM.NetworkRequest.pas
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
interface

uses
SysUtils, Classes, Contnrs, SyncObjs,
SysUtils, Classes, Contnrs, SyncObjs, Types,
OSM.SlippyMapUtils;

const
Expand Down Expand Up @@ -108,6 +108,7 @@ TNetworkRequestQueue = class
FGotTileCb: TGotTileCallbackBgThr;
FRequestFunc: TBlockingNetworkRequestFunc;
FDumbQueueOrder: Boolean;
FCurrTileNumbersRect: TRect; // rect of current view set in tile numbers

procedure Lock;
procedure Unlock;
Expand All @@ -129,6 +130,10 @@ TNetworkRequestQueue = class

// Add request for an image for `Tile` to request queue
procedure RequestTile(const Tile: TTile);
// Set current view rect in absolute map coords.
// If smart ordering facilities are enabled, tiles inside current view have
// priority when extracted from request queue.
procedure SetCurrentViewRect(const ViewRect: TRect);

// Common network request props
property RequestProps: THttpRequestProps read FRequestProps write FRequestProps;
Expand All @@ -138,6 +143,8 @@ TNetworkRequestQueue = class
// - When RequestTile adds a tile, all queued items with another zoom level
// are cancelled (use case: user quickly zooms in/out by multiple steps -
// no sense to wait for all of them to download)
// - If current view area is set via SetCurrentViewRect, the tiles inside this
// rect are downloaded first (priority of visible area)
property DumbQueueOrder: Boolean read FDumbQueueOrder write FDumbQueueOrder;
end;

Expand Down Expand Up @@ -226,6 +233,7 @@ procedure TNetworkRequestThread.Execute;
if (ReqProps.Proxy <> '') and (Pos(HTTPProxyProto, ReqProps.Proxy) = 0) then
ReqProps.Proxy := HTTPProxyProto + ReqProps.Proxy;
ms := TMemoryStream.Create;

if not FRequestFunc(ReqProps, ms, sErrMsg) then
FreeAndNil(ms)
else
Expand Down Expand Up @@ -297,7 +305,7 @@ procedure TNetworkRequestQueue.Unlock;
FCS.Leave;
end;

// Search for tile in list
// Search for tile by value in TList
function IndexOfTile(const Tile: TTile; List: TList): Integer;
begin
for Result := 0 to List.Count - 1 do
Expand Down Expand Up @@ -349,6 +357,24 @@ procedure TNetworkRequestQueue.RequestTile(const Tile: TTile);
end;
end;

procedure TNetworkRequestQueue.SetCurrentViewRect(const ViewRect: TRect);
begin
Lock;
try
// Coord rect aligned to tile sizes
FCurrTileNumbersRect := ToTileBoundary(ViewRect);
// Convert coords to tile numbers
FCurrTileNumbersRect := Rect(
FCurrTileNumbersRect.Left div TILE_IMAGE_WIDTH,
FCurrTileNumbersRect.Top div TILE_IMAGE_HEIGHT,
FCurrTileNumbersRect.Right div TILE_IMAGE_WIDTH,
FCurrTileNumbersRect.Bottom div TILE_IMAGE_HEIGHT
);
finally
Unlock;
end;
end;

// Create new thread and add to list
procedure TNetworkRequestQueue.AddThread;
var thr: TNetworkRequestThread;
Expand All @@ -370,25 +396,53 @@ procedure TNetworkRequestQueue.AddThread;
// @param RequestProps - personal copy of request properties that a thread must dispose
// @returns @True if a task was returned, @False if queue is empty
function TNetworkRequestQueue.PopTask(out pTile: PTile; out RequestProps: THttpRequestProps): Boolean;

// Search for tiles in list and return the 1st one that falls into given rect of tile numbers
// (!) Numbers, not coords (!)
function ExtractTileInView(List: TList; const ViewTileNumbersRect: TRect): OSM.SlippyMapUtils.PTile;
var idx: Integer;
begin
// Queue's list has Tail at index 0 and Head at index Count so loop accodringly
// to keep order of queued items.
for idx := List.Count - 1 downto 0 do
begin
Result := OSM.SlippyMapUtils.PTile(List[idx]);
if ViewTileNumbersRect.Contains(Point(Result.ParameterX, Result.ParameterY)) then
begin
List.Delete(idx);
Exit;
end;
end;
Result := nil;
end;

begin
// Fast check
if not FNotEmpty then
Exit(False);

pTile := nil;
RequestProps := nil;

Lock;
try
if FTaskQueue.Count > 0 then
begin
pTile := FTaskQueue.Pop;
FCurrentTasks.Add(pTile);
end
else
pTile := nil;
// First try to extract tiles currenly in view if smart ordering is enabled
// and current view is set
if not FDumbQueueOrder and (FCurrTileNumbersRect.Right <> 0) and (FCurrTileNumbersRect.Bottom <> 0) then
pTile := ExtractTileInView(TQueueHack(FTaskQueue).List, FCurrTileNumbersRect);
// Not found yet - just extract head
if pTile = nil then
pTile := FTaskQueue.Pop;
end;
Result := pTile <> nil;
if Result then
RequestProps := FRequestProps.Clone
else
RequestProps := nil;
begin
FCurrentTasks.Add(pTile);
RequestProps := FRequestProps.Clone;
end;

FNotEmpty := (FTaskQueue.Count > 0);
finally
Unlock;
Expand Down

0 comments on commit 9f6e2dd

Please sign in to comment.