LazMapViewer: Add support of GPX files.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6913 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/lazmapviewer/example/MapViewer_Demo.lpi

@@ -82,7 +82,7 @@
     </Linking>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="3">
+    <Exceptions Count="4">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -92,6 +92,9 @@
       <Item3>
         <Name Value="EFOpenError"/>
       </Item3>
+      <Item4>
+        <Name Value="EHTTPClient"/>
+      </Item4>
     </Exceptions>
   </Debugging>
 </CONFIG>

components/lazmapviewer/example/gpslistform.lfm

@@ -243,14 +243,16 @@ object GPSListViewer: TGPSListViewer
     end
   end
   object SaveDialog: TSaveDialog
+    Title = 'Save gps points as'
     DefaultExt = '.*.gps'
     Filter = 'GPS points (*.gps)|*.gps|All files (*.*)|*.*'
     left = 472
     top = 256
   end
   object OpenDialog: TOpenDialog
+    Title = 'Open gps points file'
     DefaultExt = '.gps'
-    Filter = 'GPS points (*.gps)|*.gps|All files (*.*)|*.*'
+    Filter = 'GPS files (*.gps)|*.gps|All files (*.*)|*.*'
     left = 560
     top = 256
   end

components/lazmapviewer/example/main.lfm

@@ -1,23 +1,23 @@
 object MainForm: TMainForm
   Left = 345
-  Height = 581
+  Height = 640
   Top = 121
-  Width = 869
+  Width = 883
   Caption = 'MainForm'
-  ClientHeight = 581
+  ClientHeight = 640
-  ClientWidth = 869
+  ClientWidth = 883
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   OnShow = FormShow
   ShowHint = True
   LCLVersion = '2.1.0.0'
   object ControlPanel: TPanel
-    Left = 592
+    Left = 606
-    Height = 581
+    Height = 640
     Top = 0
     Width = 277
     Align = alRight
-    ClientHeight = 581
+    ClientHeight = 640
     ClientWidth = 277
     TabOrder = 1
     object CbProviders: TComboBox
@@ -299,7 +299,7 @@ object MainForm: TMainForm
       TabOrder = 7
     end
     object CbFoundLocations: TComboBox
-      AnchorSideLeft.Control = CbLocations
+      AnchorSideLeft.Control = LblProviders
       AnchorSideTop.Control = Label8
       AnchorSideTop.Side = asrBottom
       AnchorSideRight.Control = BtnGoTo
@@ -352,10 +352,10 @@ object MainForm: TMainForm
       AnchorSideTop.Side = asrBottom
       AnchorSideRight.Control = BtnGoTo
       AnchorSideRight.Side = asrBottom
-      Left = 8
+      Left = 9
       Height = 52
-      Top = 450
+      Top = 483
-      Width = 260
+      Width = 259
       Anchors = [akTop, akLeft, akRight]
       AutoSize = False
       BorderSpacing.Top = 8
@@ -364,11 +364,12 @@ object MainForm: TMainForm
       WordWrap = True
     end
     object BtnGPSPoints: TButton
-      AnchorSideTop.Control = CbFoundLocations
+      AnchorSideLeft.Control = LblProviders
+      AnchorSideTop.Control = BtnSaveToFile
       AnchorSideTop.Side = asrBottom
-      Left = 8
+      Left = 9
       Height = 25
-      Top = 417
+      Top = 450
       Width = 92
       AutoSize = True
       BorderSpacing.Top = 8
@@ -382,10 +383,10 @@ object MainForm: TMainForm
       AnchorSideTop.Side = asrBottom
       AnchorSideRight.Control = InfoBtnGPSPoints
       AnchorSideRight.Side = asrBottom
-      Left = 8
+      Left = 9
       Height = 64
-      Top = 502
+      Top = 535
-      Width = 260
+      Width = 259
       Anchors = [akTop, akLeft, akRight]
       AutoSize = False
       Caption = 'GPSPointInfo'
@@ -493,15 +494,15 @@ object MainForm: TMainForm
       OnClick = BtnSaveMapProvidersClick
     end
     object BtnSaveToFile: TButton
-      AnchorSideLeft.Control = BtnGPSPoints
+      AnchorSideLeft.Control = LblProviders
-      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = CbFoundLocations
-      AnchorSideTop.Control = BtnGPSPoints
+      AnchorSideTop.Side = asrBottom
-      Left = 108
+      Left = 9
       Height = 25
       Top = 417
       Width = 110
       AutoSize = True
-      BorderSpacing.Left = 8
+      BorderSpacing.Top = 8
       Caption = 'Save map to file'
       OnClick = BtnSaveToFileClick
       TabOrder = 11
@@ -606,13 +607,27 @@ object MainForm: TMainForm
       TabOrder = 13
       Text = 'km'
     end
+    object BtnLoadGPXFile: TButton
+      AnchorSideLeft.Control = BtnSaveToFile
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = BtnSaveToFile
+      Left = 127
+      Height = 25
+      Top = 417
+      Width = 105
+      AutoSize = True
+      BorderSpacing.Left = 8
+      Caption = 'Load GPX file...'
+      OnClick = BtnLoadGPXFileClick
+      TabOrder = 14
+    end
   end
   object MapView: TMapView
     Left = 0
-    Height = 581
+    Height = 640
     Hint = 'Displays the map'
     Top = 0
-    Width = 592
+    Width = 606
     Active = False
     Align = alClient
     CacheOnDisk = True
@@ -634,4 +649,10 @@ object MainForm: TMainForm
     left = 328
     top = 224
   end
+  object OpenDialog: TOpenDialog
+    DefaultExt = '.pgx'
+    Filter = 'GPX files (*.gpx)|*.gpx|All files (*.*)|*.*'
+    left = 832
+    top = 424
+  end
 end

components/lazmapviewer/example/main.pas

@@ -18,6 +18,7 @@ type
     BtnGoTo: TButton;
     BtnGPSPoints: TButton;
     BtnSaveToFile: TButton;
+    BtnLoadGPXFile: TButton;
     CbDoubleBuffer: TCheckBox;
     CbFoundLocations: TComboBox;
     CbLocations: TComboBox;
@@ -49,8 +50,10 @@ type
     ControlPanel: TPanel;
     BtnLoadMapProviders: TSpeedButton;
     BtnSaveMapProviders: TSpeedButton;
+    OpenDialog: TOpenDialog;
     ZoomTrackBar: TTrackBar;
     procedure BtnGoToClick(Sender: TObject);
+    procedure BtnLoadGPXFileClick(Sender: TObject);
     procedure BtnSearchClick(Sender: TObject);
     procedure BtnGPSPointsClick(Sender: TObject);
     procedure BtnSaveToFileClick(Sender: TObject);
@@ -98,7 +101,7 @@ implementation
 
 uses
   LCLType, IniFiles, Math, FPCanvas, FPImage, IntfGraphics,
-  mvEngine, mvExtraData,
+  mvEngine, mvExtraData, mvGPX,
   globals, gpslistform;
 
 type
@@ -189,6 +192,31 @@ begin
   MapView.Invalidate;
 end;
 
+procedure TMainForm.BtnLoadGPXFileClick(Sender: TObject);
+var
+  reader: TGpxReader;
+  pt: TGpsPoint;
+  item: TGpsObj;
+begin
+  if OpenDialog.FileName <> '' then
+    OpenDialog.InitialDir := ExtractFileDir(OpenDialog.Filename);
+  if OpenDialog.Execute then begin
+    reader := TGpxReader.Create;
+    try
+      reader.LoadFromFile(OpenDialog.FileName, MapView.GPSItems);
+      item := MapView.GPSItems.Items[MapView.GPSItems.Count-1];
+      if item is TGpsPoint then
+        pt := TGpsPoint(item)
+      else
+      if item is TGpsTrack then
+        pt := TGpsTrack(item).Points[0];
+      MapView.Center := pt.RealPoint;
+    finally
+      reader.Free;
+    end;
+  end;
+end;
+
 procedure TMainForm.BtnSaveToFileClick(Sender: TObject);
 begin
   MapView.SaveToFile(TPortableNetworkGraphic, 'mapview.png');

components/lazmapviewer/lazmapviewerpkg.lpk

@@ -14,7 +14,7 @@
     <Description Value="Component for viewing maps (Google, OpenStreetMap, etc). 
 This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) which itself is based on the MapViewer by Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer)."/>
     <License Value="GPL2 or later"/>
-    <Files Count="14">
+    <Files Count="15">
       <Item1>
         <Filename Value="source/mvcache.pas"/>
         <UnitName Value="mvCache"/>
@@ -72,6 +72,10 @@ This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/c
         <HasRegisterProc Value="True"/>
         <UnitName Value="mvMapViewerReg"/>
       </Item14>
+      <Item15>
+        <Filename Value="source/mvgpx.pas"/>
+        <UnitName Value="mvgpx"/>
+      </Item15>
     </Files>
     <RequiredPkgs Count="1">
       <Item1>

components/lazmapviewer/lazmapviewerpkg.pas

@@ -4,12 +4,13 @@
 
 unit lazMapViewerPkg;
 
+{$warn 5023 off : no warning about unused units}
 interface
 
 uses
   mvCache, mvDownloadEngine, mvDragObj, mvEngine, mvGeoNames, mvGpsObj, 
   mvJobQueue, mvJobs, mvMapProvider, mvTypes, mvMapViewer, mvExtraData, 
-  mvDLEFpc, mvMapViewerReg, LazarusPackageIntf;
+  mvDLEFpc, mvMapViewerReg, mvGPX, LazarusPackageIntf;
 
 implementation
 

components/lazmapviewer/source/mvgpsobj.pas

@@ -123,6 +123,7 @@ type
     FUpdating: integer;
     FItems: TGPSObjList;
     function GetCount: integer;
+    function GetItem(AIndex: Integer): TGpsObj;
   protected
     procedure _Delete(Idx: Integer; var DelLst: TGPSObjList);
     procedure FreePending;
@@ -130,7 +131,7 @@ type
     procedure Lock;
     procedure UnLock;
     procedure CallModified(lst: TGPSObjList; Adding: boolean);
-    property Items: TGPSObjList read FItems;
+//    property Items: TGPSObjList read FItems;
     procedure IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray; IdOwner: integer);
   public
     constructor Create;
@@ -149,6 +150,7 @@ type
     procedure EndUpdate;
 
     property Count: integer read GetCount;
+    property Items[AIndex: Integer]: TGpsObj read GetItem; default;
     property OnModified: TModifiedEvent read FOnModified write FOnModified;
   end;
 
@@ -279,6 +281,11 @@ begin
   Result := FItems.Count
 end;
 
+function TGPSObjectList.GetItem(AIndex: Integer): TGpsObj;
+begin
+  Result := FItems[AIndex];
+end;
+
 procedure TGPSObjectList._Delete(Idx: Integer; var DelLst: TGPSObjList);   // wp: was "out"
 var
   Item: TGpsObj;
@@ -293,7 +300,7 @@ begin
     end;
     if not Assigned(FPending) then
       FPending := TObjectList.Create(true);
-    Item := Items.Extract(Items[Idx]);
+    Item := FItems.Extract(FItems[Idx]);
     FPending.Add(Item);
   finally
     UnLock;
@@ -393,10 +400,10 @@ begin
   Area.TopLeft.lat := 0;
   Lock;
   try
-    if Items.Count > 0 then
+    if Count > 0 then
     begin
       Area := Items[0].BoundingBox;
-      for i:=1 to pred(Items.Count) do
+      for i:=1 to pred(Count) do
       begin
         ptArea := Items[i].BoundingBox;
         ExtendArea(Area, ptArea);
@@ -416,7 +423,7 @@ begin
   Lock;
   try
     Inc(FRefCount);
-    for i:=0 to pred(Items.Count) do
+    for i:=0 to pred(Count) do
     begin
       ItemArea := Items[i].BoundingBox;
       if hasIntersectArea(Area,ItemArea) then
@@ -560,7 +567,7 @@ begin
   aItem.FIdOwner := IdOwner;
   Lock;
   try
-    Result := Items.Add(aItem);
+    Result := FItems.Add(aItem);
     mList := TGPSObjList.Create(false);
     mList.Add(aItem);
     inc(FRefCount);
@@ -594,7 +601,7 @@ begin
   DelLst := nil;
   Lock;
   try
-    for i:=Pred(Items.Count) downto 0 do
+    for i:=pred(Count) downto 0 do
     begin
       if Assigned(Items[i].ExtraData) then
       begin

components/lazmapviewer/source/mvgpx.pas

@@ -0,0 +1,299 @@
+{ Reads/writes GPX files }
+
+unit mvGPX;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, laz2_DOM, laz2_XMLRead, DateUtils,
+  mvTypes, mvGpsObj;
+
+type
+  TGpxReader = class
+  private
+    ID: Integer;
+  protected
+    function ReadPoint(ANode: TDOMNode): TGpsPoint;
+    procedure ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist);
+    procedure ReadTrack(ANode: TDOMNode; AList: TGpsObjectList);
+    procedure ReadTracks(ANode: TDOMNode; AList: TGpsObjectList);
+    procedure ReadTrackSegment(ANode: TDOMNode; ATrack: TGpsTrack);
+    procedure ReadWayPoints(ANode: TDOMNode; AList: TGpsObjectList);
+  public
+    procedure LoadFromFile(AFileName: String; AList: TGpsObjectList);
+    procedure LoadFromStream(AStream: TStream; AList: TGpsObjectList);
+  end;
+
+implementation
+
+var
+  PointSettings: TFormatSettings;
+
+function ExtractISODateTime(AText: String): TDateTime;
+type
+  TISODateRec = packed record
+    Y: array[0..3] of ansichar;
+    SepYM: ansichar;
+    M: array[0..1] of ansichar;
+    SepMD: ansichar;
+    D: array[0..1] of ansichar;
+  end;
+  PISODateRec = ^TISODateRec;
+  TISOTimeRec = packed record
+    H: array[0..1] of ansichar;
+    SepHM: ansichar;
+    M: array[0..1] of ansichar;
+    SepMS: ansiChar;
+    S: array[0..1] of ansichar;
+    DecSep: ansichar;
+    MS: array[0..2] of ansichar;
+  end;
+  PISOTimeRec = ^TISOTimeRec;
+const
+  NUMBER: array['0'..'9'] of Integer = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9);
+const
+  ZERO = ord('0');
+var
+  yr,mon,dy, hr,mn,sec,s1000: Integer;
+begin
+  if Pos('T', AText) = 11 then begin
+    with PISODateRec(PChar(@AText[1]))^ do begin
+      yr := 1000*NUMBER[Y[0]] + 100*NUMBER[Y[1]] + 10*NUMBER[Y[2]] + NUMBER[Y[3]];
+      mon := 10*NUMBER[M[0]] + NUMBER[M[1]];
+      dy := 10*NUMBER[D[0]] + NUMBER[D[1]];
+    end;
+    with PISOTimeRec(PChar(@AText[12]))^ do begin
+      hr := 10*NUMBER[H[0]] + NUMBER[H[1]];
+      mn := 10*NUMBER[M[0]] + NUMBER[M[1]];
+      sec := 10*NUMBER[S[0]] + NUMBER[S[1]];
+      s1000 := 100*NUMBER[MS[0]] + 10*NUMBER[MS[1]] + NUMBER[MS[2]];
+    end;
+    Result := EncodeDate(yr, mon, dy) + EncodeTime(hr, mn, sec, s1000);
+  end else
+  if not TryStrToDateTime(AText, Result) then
+    Result := NO_DATE;
+end;
+
+function GetAttrValue(ANode: TDOMNode; AAttrName: string) : string;
+var
+  i: LongWord;
+  Found: Boolean;
+begin
+  Result := '';
+  if (ANode = nil) or (ANode.Attributes = nil) then
+    exit;
+
+  Found := false;
+  i := 0;
+  while not Found and (i < ANode.Attributes.Length) do begin
+    if ANode.Attributes.Item[i].NodeName = AAttrName then begin
+      Found := true;
+      Result := ANode.Attributes.Item[i].NodeValue;
+    end;
+    inc(i);
+  end;
+end;
+
+function GetNodeValue(ANode: TDOMNode): String;
+var
+  child: TDOMNode;
+begin
+  Result := '';
+  child := ANode.FirstChild;
+  if Assigned(child) and (child.NodeName = '#text') then
+    Result := child.NodeValue;
+end;
+
+procedure TGpxReader.LoadFromFile(AFileName: String; AList: TGpsObjectList);
+var
+  stream: TStream;
+begin
+  stream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone);
+  try
+    LoadFromStream(stream, AList);
+  finally
+    stream.Free;
+  end;
+end;
+
+procedure TGpxReader.LoadFromStream(AStream: TStream; AList: TGpsObjectList);
+var
+  doc: TXMLDocument = nil;
+  node: TDOMNode;
+begin
+  try
+    ID := random(MaxInt - 1000) + 1000;
+    ReadXMLFile(doc, AStream);
+    ReadWayPoints(doc.DocumentElement.FindNode('wpt'), AList);
+    ReadTracks(doc.DocumentElement.FindNode('trk'), AList);
+    ReadRoute(doc.DocumentElement.FindNode('rte'), AList);
+  finally
+    doc.Free;
+  end;
+end;
+
+function TGpxReader.ReadPoint(ANode: TDOMNode): TGpsPoint;
+var
+  s, slon, slat, sName: String;
+  lon, lat, ele: Double;
+  dt: TDateTime;
+  node: TDOMNode;
+  nodeName: String;
+begin
+  Result := nil;
+  if ANode = nil then
+    exit;
+
+  slon := GetAttrValue(ANode, 'lon');
+  slat := GetAttrValue(ANode, 'lat');
+  if (slon = '') or (slat = '') then
+    exit;
+
+  if not TryStrToFloat(slon, lon, PointSettings) then
+    exit;
+  if not TryStrToFloat(slat, lat, PointSettings) then
+    exit;
+
+  sName := '';
+  dt := NO_DATE;
+  ele := NO_ELE;
+  node := ANode.FirstChild;
+  while node <> nil do begin
+    nodeName := node.NodeName;
+    case nodeName of
+      'ele' :
+        begin
+          s := GetNodeValue(node);
+          if s <> '' then
+            TryStrToFloat(s, ele, PointSettings);
+        end;
+      'name':
+        sName := GetNodeValue(node);
+      'time':
+        begin
+          s := GetNodeValue(node);
+          if s <> '' then
+            dt := ExtractISODateTime(s);
+        end;
+    end;
+    node := node.NextSibling;
+  end;
+  Result := TGpsPoint.Create(lon, lat, ele, dt);
+  Result.Name := sname;
+end;
+
+procedure TGpxReader.ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist);
+var
+  trk: TGpsTrack;
+  nodeName: string;
+  pt: TGpsPoint;
+  trkName: String;
+begin
+  if ANode = nil then
+    exit;
+  ANode := ANode.FirstChild;
+  if ANode = nil then
+    exit;
+  trk := TGpsTrack.Create;
+  while ANode <> nil do begin
+    nodeName := ANode.NodeName;
+    case nodeName of
+      'name':
+        trkName := GetNodeValue(ANode);
+      'rtept':
+        begin
+          pt := ReadPoint(ANode);
+          if pt <> nil then trk.Points.Add(pt);
+        end;
+    end;
+    ANode := ANode.NextSibling;
+  end;
+  trk.Name := trkName;
+  AList.Add(trk, ID);
+end;
+
+procedure TGpxReader.ReadTrack(ANode: TDOMNode; AList: TGpsObjectList);
+var
+  trk: TGpsTrack;
+  nodeName: string;
+  pt: TGpsPoint;
+  trkName: String = '';
+begin
+  if ANode = nil then
+    exit;
+  ANode := ANode.FirstChild;
+  if ANode = nil then
+    exit;
+
+  trk := TGpsTrack.Create;
+  while ANode <> nil do begin
+    nodeName := ANode.NodeName;
+    case nodeName of
+      'name':
+        trkName := GetNodeValue(ANode);
+      'trkseg':
+        ReadTrackSegment(ANode.FirstChild, trk);
+      'trkpt':
+        begin
+          pt := ReadPoint(ANode);
+          if pt <> nil then trk.Points.Add(pt);
+        end;
+    end;
+    ANode := ANode.NextSibling;
+  end;
+  trk.Name := trkName;
+  AList.Add(trk, ID);
+end;
+
+procedure TGpxReader.ReadTracks(ANode: TDOMNode; AList: TGpsObjectList);
+var
+  nodeName: String;
+begin
+  while ANode <> nil do begin
+    nodeName := ANode.NodeName;
+    if nodeName = 'trk' then
+      ReadTrack(ANode, AList);
+    ANode := ANode.NextSibling;
+  end;
+end;
+
+procedure TGpxReader.ReadTrackSegment(ANode: TDOMNode; ATrack: TGpsTrack);
+var
+  gpsPt: TGpsPoint;
+  nodeName: String;
+begin
+  while ANode <> nil do begin
+    nodeName := ANode.NodeName;
+    if nodeName = 'trkpt' then begin
+      gpsPt := ReadPoint(ANode);
+      if gpsPt <> nil then
+        ATrack.Points.Add(gpsPt);
+    end;
+    ANode := ANode.NextSibling;
+  end;
+end;
+
+procedure TGpxReader.ReadWayPoints(ANode: TDOMNode; AList: TGpsObjectList);
+var
+  nodeName: String;
+  gpsPt: TGpsPoint;
+begin
+  while ANode <> nil do begin
+    nodeName := ANode.NodeName;
+    if nodeName = 'wpt' then begin
+      gpsPt := ReadPoint(ANode);
+      if gpsPt <> nil then
+        AList.Add(gpsPt, ID);
+    end;
+    ANode := ANode.NextSibling;
+  end;
+end;
+
+initialization
+  PointSettings := DefaultFormatSettings;
+  PointSettings.DecimalSeparator := '.';
+
+end.
+

components/lazmapviewer/source/mvmapviewer.pas

@@ -63,7 +63,7 @@ Type
       procedure CallAsyncInvalidate;
       procedure DoAsyncInvalidate({%H-}Data: PtrInt);
       procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer);
-      procedure DrawPt(const {%H-}Area: TRealArea;aPOI: TGPSPoint);
+      procedure DrawPt(const {%H-}Area: TRealArea; aPOI: TGPSPoint);
       procedure DrawTrack(const Area: TRealArea; trk: TGPSTrack);
       function GetCacheOnDisk: boolean;
       function GetCachePath: String;