LazMapViewer: Calculation of bearing, target point by bearing, midpoint, intermediate point. First, Last of TMapCollection, TMapPoint.ToScreen property. TGPSTrack draw event and ConnectColor/Width properties. Better GPX import/export.

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

components/lazmapviewer/source/mvengine.pas

@@ -208,11 +208,18 @@ type
   end;
 
 function RealPoint(Lat, Lon: Double): TRealPoint;
+function NormalizeLon(const Lon: Double): Double; inline;
 
 function HaversineDist(Lat1, Lon1, Lat2, Lon2, Radius: Double): Double;
 function CalcGeoDistance(Lat1, Lon1, Lat2, Lon2: double;
   AUnits: TDistanceUnits = duKilometers): double;
 
+function CalcBearing(Lat1, Lon1, Lat2, Lon2: Double): Double;
+procedure CalcLatLon(const Lat1, Lon1, ADist, ABearing: Double; out Lat2, Lon2: Double);
+procedure CalcMidpoint(const Lat1, Lon1, Lat2, Lon2: Double; out Lat, Lon: Double);
+procedure CalcIntermedPoint(const Lat1, Lon1, Lat2, Lon2, AFrac: Double; out Lat, Lon: Double);
+
+
 function DMSToDeg(Deg, Min: Word; Sec: Double): Double;
 function GPSToDMS(Angle: Double): string;
 function GPSToDMS(Angle: Double; AFormatSettings: TFormatSettings): string;
@@ -1817,6 +1824,96 @@ begin
   end;
 end;
 
+{ Calculate initial bearing (in °) from the start point Lat1,Lon1 to
+  the end point Lat2,Lon2. No parameter checks, result normalized to 0°..360°.
+}
+function CalcBearing(Lat1, Lon1, Lat2, Lon2: Double): Double;
+var
+  latFrom, latTo, lonDiff: Double;
+begin
+  lonDiff := DegToRad(Lon2 - Lon1);
+  latFrom := DegToRad(Lat1);
+  latTo := DegToRad(Lat2);
+  Result := ArcTan2(Sin(lonDiff) * Cos(latTo),
+    Cos(latFrom) * Sin(latTo) - Sin(latFrom) * Cos(latTo) * Cos(lonDiff));
+  Result := RadToDeg(Result);
+  if Result < 0.0 then
+    Result := Result + 360.0;
+end;
+
+{ Calculate end point Lat2,Lon2 by given start point Lat1,Lon1, distance
+  ADist (in meters) and bearing ABearing (in °). No parameter checks,
+  result Lon2 normalized to -180°..180°.
+}
+procedure CalcLatLon(const Lat1, Lon1, ADist, ABearing: Double; out Lat2,
+  Lon2: Double);
+var
+  latFrom, lonFrom, brng, aD: Double;
+begin
+  latFrom := DegToRad(Lat1);
+  lonFrom := DegToRad(Lon1);
+  brng := DegToRad(ABearing);
+  aD := ADist / EARTH_EQUATORIAL_RADIUS;
+  Lat2 := ArcSin(Sin(latFrom) * Cos(aD) + Cos(latFrom) * Sin(aD) * Cos(brng));
+  Lon2 := lonFrom + ArcTan2(Sin(brng) * Sin(aD) * Cos(latFrom),
+    Cos(aD) - Sin(latFrom) * Sin(Lat2));
+  Lat2 := RadToDeg(Lat2);
+  Lon2 := NormalizeLon(RadToDeg(Lon2));
+end;
+
+{ Calculate midpoint Lat,Lon by given start point Lat1,Lon1 and end point
+  Lat2,Lon2. No parameter checks, result Lon normalized to -180°..180°.
+}
+procedure CalcMidpoint(const Lat1, Lon1, Lat2, Lon2: Double; out Lat,
+  Lon: Double);
+var
+  latFrom, lonDiff, latTo, lonTo, Bx, By: Double;
+begin
+  lonDiff := DegToRad(Lon2 - Lon1);
+  latFrom := DegToRad(Lat1);
+  latTo := DegToRad(Lat2);
+  lonTo := DegToRad(Lon2);
+  Bx := Cos(latTo) * Cos(lonDiff);
+  By := Cos(latTo) * Sin(lonDiff);
+  Lat := ArcTan2(Sin(latFrom) + Sin(latTo), Sqrt(Sqr(Cos(latFrom) + Bx) + Sqr(By)));
+  Lon := lonTo + ArcTan2(By, Cos(latFrom) + By);
+  Lat := RadToDeg(Lat);
+  Lon := NormalizeLon(RadToDeg(Lon));
+end;
+
+{ Calculate intermediate point Lat,Lon by given start point Lat1,Lon1, end point
+  Lat2,Lon2 and fraction AFrac (0.0-1.0). No parameter checks, result Lon
+  normalized to -180°..180°.
+}
+procedure CalcIntermedPoint(const Lat1, Lon1, Lat2, Lon2, AFrac: Double; out
+  Lat, Lon: Double);
+var
+  latFrom, lonFrom, latTo, lonTo: Double;
+  A, B, aD, X, Y, Z: Double;
+begin
+  aD := CalcGeoDistance(Lat1, Lon1, Lat2, Lon2) / EARTH_EQUATORIAL_RADIUS;
+  latFrom := DegToRad(Lat1);
+  lonFrom := DegToRad(Lon1);
+  latTo := DegToRad(Lat2);
+  lonTo := DegToRad(Lon2);
+  A := Sin((1.0 - AFrac) * aD) / Sin(aD);
+  B := Sin(AFrac * aD) / Sin(aD);
+  X := A * Cos(latFrom) * Cos(lonFrom) + B * Cos(latTo) * Cos(lonTo);
+  Y := A * Cos(latFrom) * Sin(lonFrom) + B * Cos(latTo) * Sin(lonTo);
+  Z := A * Sin(latFrom) + B * Sin(latTo);
+  Lat := ArcTan2(Z, Sqrt(Sqr(X) + Sqr(Y)));
+  Lon := ArcTan2(Y, X);
+  Lat := RadToDeg(Lat);
+  Lon := NormalizeLon(RadToDeg(Lon));
+end;
+
+function NormalizeLon(const Lon: Double): Double;
+begin
+  if InRange(Lon, -180.0, 180.0)
+    then Result := Lon
+    else Result := FMod(Lon + 540.0, 360.0) - 180.0;
+end;
+
 { Converts an angle given as degrees, minutes and seconds to a single
   floating point degrees value. }
 function DMSToDeg(Deg, Min: Word; Sec: Double): Double;

components/lazmapviewer/source/mvgpsobj.pas

@@ -150,6 +150,8 @@ type
 
   TGPSTrack = class(TGPSPolyLine)
   private
+    FConnectColor: TColor;
+    FConnectWidth: Double;
     FDateTime: TDateTime;
     FLineWidth: Double;  // Line width in mm
     FLineColor: TColor;
@@ -163,6 +165,8 @@ type
     property DateTime: TDateTime read GetDateTime write FDateTime;
     property LineColor: TColor read FLineColor write FLineColor;
     property LineWidth: Double read FLineWidth write FLineWidth;
+    property ConnectColor: TColor read FConnectColor write FConnectColor;
+    property ConnectWidth: Double read FConnectWidth write FConnectWidth;
   end;
 
   { TGPSArea }
@@ -933,12 +937,16 @@ begin
   inherited;
   FLineColor := clDefault;  // --> use MapView.DefaultTrackColor
   FLineWidth := -1;         // --> use MapView.DefaultTrackWidth
+  FConnectColor := clNone;  // --> None, clDefault for LineColor
+  FConnectWidth := -1;      // --> use LineWidth
 end;
 
 
 procedure TGPSTrack.Draw(AView: TObject; Area: TRealArea);
 begin
-  TMapView(AView).DrawTrack(Area, Self);
+  if Assigned(FOnDrawObj)
+    then FOnDrawObj(AView, Self, Area)
+    else TMapView(AView).DrawTrack(Area, Self);
 end;
 
 function TGPSTrack.TrackLengthInKm(UseEle: Boolean): double;

components/lazmapviewer/source/mvgpx.pas

@@ -28,7 +28,8 @@ type
     ID: Integer;
     FMinLat, FMinLon, FMaxLat, FMaxLon: Double;
   protected
-    procedure ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack);
+    procedure ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack); overload;
+    procedure ReadExtensions(ANode: TDOMNode; APt: TGPSPoint); overload;
     function ReadPoint(ANode: TDOMNode): TGpsPoint;
     procedure ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist);
     procedure ReadTrack(ANode: TDOMNode; AList: TGpsObjectList);
@@ -187,36 +188,26 @@ var
 begin
   Result := '';
   child := ANode.FirstChild;
-  if Assigned(child) and (child.NodeName = '#text') then
+  if Assigned(child) and ((child.NodeName = '#text') or
+    (child.NodeName = '#cdata-section'))
+  then
     Result := child.NodeValue;
 end;
 
-function TryStrToGpxColor(AGpxText: String; out AColor: LongInt): Boolean;
+function TryStrToGpxColor(AGpxText: String; out AColor: TColor): Boolean;
-//type
-//  PGpxColorRec = ^TGpxColorRec;
-//  TGpxColorRec = record
-//    r: array[0..1] of char;
-//    g: array[0..1] of char;
-//    b: array[0..1] of char;
-//  end;
-//var
-//  rv, gv, bv: Integer;
-//  ch: Char;
 begin
-  Result := false;
+  if AGpxText = 'default' then
+  begin
+    AColor := clDefault;
+    Exit(True);
+  end;
+  if AGpxText = 'none' then
+  begin
+    AColor := clNone;
+    Exit(True);
+  end;
   if Length(AGpxText) <> 6 then
-    exit;
+    Exit;
-  //for ch in AGpxText do
-  //  if not (ch in ['0'..'9', 'A'..'F', 'a'..'f']) then exit;
-
-    (* Doesn't work for letters! *)
-
-  //with PGpxColorRec(@AGpxText[1])^ do begin
-  //  rv := (ord(r[0]) - ord('0')) * 16 + ord(r[1]) - ord('0');
-  //  gv := (ord(g[0]) - ord('0')) * 16 + ord(g[1]) - ord('0');
-  //  bv := (ord(b[0]) - ord('0')) * 16 + ord(b[1]) - ord('0');
-  //end;
-  //AColor := rv + gv shl 8 + bv shl 16;
   Result := TryStrToInt('$' + AGpxText, AColor);
   if Result then
     AColor := ((AColor and $FF) shl 16) + (AColor and $FF00) + ((AColor and $FF0000) shr 16);
@@ -277,6 +268,7 @@ class procedure TGpxWriter.SaveToStream(AStream: TStream; AList: TGpsObjectList
 var
   Doc: TXMLDocument;
   RootNode: TDOMNode;
+  Ex, LineEx: TDOMElement;
   I: Integer;
   O: TGPSObj;
 
@@ -287,23 +279,60 @@ var
       Doc.CreateTextNode(AValue));
   end;
 
-  function CreatePoint(AName: String; APOI: TGPSPoint): TDOMElement;
+  function ColorToGPXColor(C: TColor): LongInt;
   begin
+    Result := ColorToRGB(C);
+    Result := ((Result and $FF) shl 16) + (Result and $FF00) + ((Result and $FF0000) shr 16);
+  end;
+
+  function ColorToGPXColorStr(C: TColor): String;
+  begin
+    if (C = clDefault)
+      then Result := 'default'
+      else if (C = clNone)
+        then Result := 'none'
+        else Result := ColorToGPXColor(C).ToHexString(6);
+  end;
+
+  function AddEx(AElm: TDOMElement): TDOMElement;
+  begin
+    if not Assigned(Ex) then
+      Ex := Doc.CreateElement('extensions');
+    Ex.AppendChild(AElm);
+    Result := AElm;
+  end;
+
+  function CreatePoint(AName: String; APt: TGPSPoint): TDOMElement;
+  var
+    Img: Integer = -1;
+  begin
+    Ex := Nil; LineEx := Nil;
     Result := Doc.CreateElement(AName);
-    Result.SetAttribute('lat', APOI.Lat.ToString);
+    Result.SetAttribute('lat', APt.Lat.ToString);
-    Result.SetAttribute('lon', APOI.Lon.ToString);
+    Result.SetAttribute('lon', APt.Lon.ToString);
-    if APOI.Name <> '' then
+    if APt.Name <> '' then
-      CreateTextElement(Result, 'name', APOI.Name);
+      CreateTextElement(Result, 'name', APt.Name);
-    if APOI.Elevation <> NO_ELE then
+    if APt.Elevation <> NO_ELE then
-      CreateTextElement(Result, 'ele', APOI.Elevation.ToString);
+      CreateTextElement(Result, 'ele', APt.Elevation.ToString);
-    if APOI.DateTime <> NO_DATE then
+    if APt.DateTime <> NO_DATE then
-      CreateTextElement(Result, 'time', DateToISO8601(APOI.DateTime));
+      CreateTextElement(Result, 'time', DateToISO8601(APt.DateTime));
+    if (APt is TGPSPointOfInterest) then
+      Img := TGPSPointOfInterest(APt).ImageIndex;
+    if not APt.Visible or (Img <> -1) then
+    begin
+      LineEx := AddEx(Doc.CreateElement('misc'));
+      if not APt.Visible then
+        CreateTextElement(LineEx, 'visible', '0');
+      if Img <> -1 then
+        CreateTextElement(LineEx, 'image', Img.ToString);
+    end;
+    if Assigned(Ex) then
+      Result.AppendChild(Ex);
   end;
 
   function CreateTrack(AName: String; ATrack: TGPSTrack): TDOMElement;
   var
-    Seg, LineEx, Ex: TDOMElement;
+    Seg: TDOMElement;
-    L: LongInt;
 
     procedure CreateSegments;
     var
@@ -321,21 +350,29 @@ var
     end;
 
   begin
+    Ex := Nil;
     Result := Doc.CreateElement(AName);
     if ATrack.Name <> '' then
       CreateTextElement(Result, 'name', ATrack.Name);
-    if Assigned(ATrack.ExtraData) and (ATrack.ExtraData is TTrackExtraData) then
+    if not ATrack.Visible then
-      with TTrackExtraData(ATrack.ExtraData) do
     begin
-        Ex := Doc.CreateElement('extensions');
+      LineEx := AddEx(Doc.CreateElement('misc'));
-        LineEx := Doc.CreateElement('line');
+      CreateTextElement(LineEx, 'visible', '0');
-        Ex.AppendChild(LineEx);
-        Result.AppendChild(Ex);
-        L := ColorToRGB(Color);
-        L := ((L and $FF) shl 16) + (L and $FF00) + ((L and $FF0000) shr 16);
-        CreateTextElement(LineEx, 'color', L.ToHexString(6));
-        CreateTextElement(LineEx, 'width', Width.ToString);
     end;
+    if (ATrack.LineColor <> clDefault) or (ATrack.LineWidth > 0) then
+    begin
+      LineEx := AddEx(Doc.CreateElement('line'));
+      CreateTextElement(LineEx, 'color', ColorToGPXColorStr(ATrack.LineColor));
+      CreateTextElement(LineEx, 'width', ATrack.LineWidth.ToString);
+    end;
+    if (ATrack.ConnectColor <> clNone) or (ATrack.ConnectWidth > 0) then
+    begin
+      LineEx := AddEx(Doc.CreateElement('segconn'));
+      CreateTextElement(LineEx, 'color', ColorToGPXColorStr(ATrack.ConnectColor));
+      CreateTextElement(LineEx, 'width', ATrack.ConnectWidth.ToString);
+    end;
+    if Assigned(Ex) then
+      Result.AppendChild(Ex);
     if ATrack.Points.Count > 0 then
     begin
       Seg := Doc.CreateElement('trkseg');
@@ -354,6 +391,7 @@ begin
     TDOMElement(RootNode).SetAttribute('creator',
       'LazMapViewer https://wiki.lazarus.freepascal.org/LazMapViewer');
 
+    Ex := Nil;
     for I := 0 to Pred(AList.Count) do
     begin
       O := AList[I];
@@ -392,47 +430,60 @@ begin
   Result := LoadFromStream(AStream, AList, area);
 end;
 
+function FindChild(ANode: TDOMNode; APath: TStringArray): TDOMNode;
+var
+  N: TDOMNode;
+begin
+  Result := Nil;
+  if not Assigned(ANode) or (Length(APath) < 1) then
+    Exit;
+  N := ANode.FirstChild;
+  while Assigned(N) do
+  begin
+    if APath[0] = N.NodeName then
+      if Length(APath) > 1
+        then Exit(FindChild(N, Copy(APath, 1, Pred(Length(APath)))))
+        else Exit(N);
+    N := N.NextSibling;
+  end;
+end;
+
 procedure TGpxReader.ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack);
 var
-  linenode: TDOMNode;
+  N: TDOMNode;
-  childNode: TDOMNode;
+  color: TColor;
-  nodeName: string;
+  inv: LongInt;
-  color: LongInt;
   w: Double = -1;
-  colorUsed: Boolean = false;
-  s: String;
 begin
-  if ANode = nil then
+  if ANode = Nil then
-    exit;
+    Exit;
+  N := FindChild(ANode, ['line', 'color']);
+  if Assigned(N) and TryStrToGpxColor(GetNodeValue(N), color) then
+    ATrack.LineColor := color;
+  N := FindChild(ANode, ['line', 'width']);
+  if Assigned(N) and TryStrToFloat(GetNodeValue(N), w, PointSettings) and (w > 0) then
+    ATrack.LineWidth := w;
+  N := FindChild(ANode, ['segconn', 'color']);
+  if Assigned(N) and TryStrToGpxColor(GetNodeValue(N), color) then
+    ATrack.ConnectColor := color;
+  N := FindChild(ANode, ['segconn', 'width']);
+  if Assigned(N) and TryStrToFloat(GetNodeValue(N), w, PointSettings) and (w > 0) then
+    ATrack.ConnectWidth := w;
+  N := FindChild(ANode, ['visible']);
+  if Assigned(N) and TryStrToInt(GetNodeValue(N), inv) then
+    ATrack.Visible := inv <> 0;
+end;
 
-  lineNode := ANode.FirstChild;
+procedure TGpxReader.ReadExtensions(ANode: TDOMNode; APt: TGPSPoint);
-  while lineNode <> nil do begin
+var
-    nodeName := lineNode.NodeName;
+  N: TDOMNode;
-    if nodeName = 'line' then begin
+  inv: LongInt;
-      childNode := lineNode.FirstChild;
+begin
-      while childNode <> nil do begin
+  if ANode = Nil then
-        nodeName := childNode.NodeName;
+    Exit;
-        s := GetNodeValue(childNode);
+  N := FindChild(ANode, ['visible']);
-        case nodeName of
+  if Assigned(N) and TryStrToInt(GetNodeValue(N), inv) then
-          'color':
+    APt.Visible := inv <> 0;
-            if TryStrToGpxColor(s, color) then colorUsed := true;
-          'width':
-            TryStrToFloat(s, w, PointSettings);
-        end;
-        childNode := childNode.NextSibling;
-      end;
-    end;
-    lineNode := lineNode.NextSibling;
-  end;
-
-  if (w <> -1) or colorUsed then begin
-    if ATrack.ExtraData = nil then
-      ATrack.ExtraData := TTrackExtraData.Create(ID);
-    if (ATrack.ExtraData is TTrackExtraData) then begin
-      TTrackExtraData(ATrack.ExtraData).Width := w;
-      TTrackExtraData(ATrack.ExtraData).Color := color;
-    end;
-  end;
 end;
 
 function TGpxReader.ReadPoint(ANode: TDOMNode): TGpsPoint;
@@ -460,6 +511,7 @@ begin
   sName := '';
   dt := NO_DATE;
   ele := NO_ELE;
+  Result := TGpsPoint.Create(lon, lat, ele, dt);
   node := ANode.FirstChild;
   while node <> nil do begin
     nodeName := node.NodeName;
@@ -478,11 +530,14 @@ begin
           if s <> '' then
             dt := ExtractISODateTime(s);
         end;
+      'extensions':
+        ReadExtensions(node, Result);
     end;
     node := node.NextSibling;
   end;
-  Result := TGpsPoint.Create(lon, lat, ele, dt);
   Result.Name := sname;
+  Result.Elevation := ele;
+  Result.DateTime := dt;
   FMinLon := Min(FMinLon, lon);
   FMaxLon := Max(FMaxLon, lon);
   FMinLat := Min(FMinLat, lat);

components/lazmapviewer/source/mvmapviewer.pas

@@ -167,8 +167,10 @@ type
   { TMapLayers }
 
   TMapLayers = class(specialize TMapCollection<TMapLayer, TMapView>)
+  protected
     function GetView: TMapView; override;
     function GetLayer: TMapLayer; override;
+    procedure FixOrder(APrevIndex, AIndex: Integer); override;
   end;
 
   { TMapCenter }
@@ -1355,6 +1357,21 @@ begin
   Result := Nil;
 end;
 
+procedure TMapLayers.FixOrder(APrevIndex, AIndex: Integer);
+var
+  I, T, B: Integer;
+begin
+  T := Min(APrevIndex, AIndex);
+  B := Max(APrevIndex, AIndex);
+  if APrevIndex < 0 then
+  begin
+    T := AIndex;
+    B := Pred(Count);
+  end;
+  for I := T to B do
+    View.GPSItems.ChangeZOrder(TMapItem(Items[I]).GPSObj, I + FBaseZ);
+end;
+
 { TDrawObjJob }
 
 function TDrawObjJob.pGetTask: integer;