unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;

type
  tTrkPt = record
    lat,lon,ele,time: string;
  end;
  tTrack = record
    name:   string;
    trkPts: array of tTrkPt;
  end;
  tGpxInhalt = record
    kopf: String;
    trks: array of tTrack;
  end;
  tGpxFile = record
    prefix: array of string;
    gpx: array of tGPXInhalt;
  end;

  { tForm1 }

  tForm1 = class(tForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Image1: TImage;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox3Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    d: tGpxFile;
    procedure zeichneGpxs;
    procedure zeichneTrks;
    procedure zeichneTrkPts;
    procedure zeichne;
  end;

var
  form1: tForm1;

function gibFarbe(i: integer): tColor;
function mystrtofloat(S: String): extended;

implementation

uses
  math;

{$R *.lfm}

var
  farben: array of tColor;

function gibFarbe(i: integer): tColor;
begin
  randomize;
  while i>=length(farben) do begin
    setLength(farben,length(farben)+1);
    farben[length(farben)-1]:=random($1000000);
  end;
  result:=farben[i];
end;

function mystrtofloat(S: String): extended;
begin
  while pos('.',S)>0 do
    S[pos('.',S)]:=',';
  result:=strtofloat(S);
end;

{ tForm1 }

procedure tForm1.Button1Click(Sender: TObject);
var
  f: text;
  s: string;
  m,cnt: integer;
begin
  if opendialog1.execute then begin
    setLength(D.Prefix,0);
    setLength(D.GPX,0);
    Assignfile(F,openDialog1.fileName);
    Reset(F);
    M:=0;
    cnt:=0;
    s:='';
    while (s<>'') or not eof(F) do begin inc(cnt);
      if s='' then Readln(F,S);
      case M of
        0:
          if pos('<gpx ',S)>0 then begin
            setLength(D.GPX,length(D.GPX)+1);
            setLength(D.GPX[length(D.GPX)-1].Trks,0);
            delete(S,1,pos('<gpx ',S)+3);
            delete(S,pos('>',S),length(S));
            D.GPX[length(D.GPX)-1].Kopf:=S;
            inc(M);
          end
            else begin
            setLength(D.Prefix,length(D.Prefix)+1);
            D.Prefix[length(D.Prefix)-1]:=S;
            s:='';
          end;
        1:
          if pos('<trk>',S)>0 then begin             inc(cnt);
            setLength(D.GPX[length(D.GPX)-1].Trks,length(D.GPX[length(D.GPX)-1].Trks)+1);
            D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].Name:='';
            setLength(D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts,0);
            inc(M);
          end
            else
          dec(M);
        2:
          if pos('<name>',S)>0 then begin
            delete(S,1,pos('<name>',S)+5);
            delete(S,pos('</name>',S),length(S));
            D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].Name:=S;
          end
          else if pos('<trkseg>',S)>0 then
            inc(M)
          else
            dec(M);
        3:
          if pos('<trkpt ',S)>0 then begin
            setLength(D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts,
               length(D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts)+1);
            with D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts[
                 length(D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts)-1] do begin
              delete(S,1,pos('lat="',S)+4);
              lat:=copy(S,1,pos('"',S)-1);
              delete(S,1,pos('lon="',S)+4);
              lon:=copy(S,1,pos('"',S)-1);
              if eof(F) then exit;
              readln(F,S);
              delete(S,1,pos('<ele>',S)+4);
              ele:=copy(S,1,pos('</ele>',S)-1);
              if eof(F) then exit;
              readln(F,S);
              delete(S,1,pos('<time>',S)+5);
              time:=copy(S,1,pos('</time>',S)-1);
            end;
          end
          else if pos('</trkseg>',S)>0 then
            dec(M);
      end{of Case};
    end;
    Closefile(F);
  end;
  ZeichneGPXs;
  messagedlg('ok ('+inttostr(cnt)+')',mtinformation,[mbOk],0);
end;

procedure tForm1.Button2Click(Sender: TObject);
var
  F:     text;
  I,J,K: Integer;
begin
  if Savedialog1.Execute then begin
    Assignfile(F,Savedialog1.FileName);
    Rewrite(F);
    for I:=0 to length(D.Prefix)-1 do
      Writeln(F,D.Prefix[I]);
    for I:=0 to length(D.GPX)-1 do begin
      writeln(F,'<gpx'+D.GPX[I].Kopf+'>');
      for J:=0 to length(D.GPX[I].Trks)-1 do begin
        writeln(F,' <trk>');
        while pos('<',D.GPX[I].Trks[J].Name)>0 do
          D.GPX[I].Trks[J].Name[pos('<',D.GPX[I].Trks[J].Name)]:='-';
        while pos('>',D.GPX[I].Trks[J].Name)>0 do
          D.GPX[I].Trks[J].Name[pos('>',D.GPX[I].Trks[J].Name)]:='+';
        writeln(F,'  <name>'+D.GPX[I].Trks[J].Name+'</name>');
        writeln(F,'  <trkseg>');
        for K:=0 to length(D.GPX[I].Trks[J].TrkPts)-1 do begin
          writeln(F,'   <trkpt lat="'+D.GPX[I].Trks[J].TrkPts[K].lat+
                    '" lon="'+D.GPX[I].Trks[J].TrkPts[K].lon+'">');
          writeln(F,'    <ele>'+D.GPX[I].Trks[J].TrkPts[K].ele+'</ele>');
          writeln(F,'    <time>'+D.GPX[I].Trks[J].TrkPts[K].time+'</time>');
          writeln(F,'   </trkpt>');
        end;
        writeln(F,'  </trkseg>');
        writeln(F,' </trk>');
      end;
      writeln(F,'</gpx>');
    end;
    Closefile(F);
  end;
end;

procedure tForm1.Button3Click(Sender: TObject);
var
  I: Integer;
begin
  if Listbox1.ItemIndex<0 then exit;
  if Listbox2.ItemIndex<0 then exit;
  if Listbox3.ItemIndex<0 then exit;
  with D.GPX[Listbox1.Itemindex] do begin
    setlength(Trks,length(Trks)+1);
    for I:=length(Trks)-1 downto Listbox2.ItemIndex+1 do
      Trks[I]:=Trks[I-1];
    setlength(Trks[Listbox2.Itemindex].TrkPts,Listbox3.ItemIndex+1);
    Trks[Listbox2.Itemindex].Name:=Trks[Listbox2.Itemindex].Name+'<';
    with Trks[Listbox2.Itemindex+1] do begin
      for I:=Listbox3.ItemIndex to length(TrkPts)-1 do
        TrkPts[I-Listbox3.ItemIndex]:=TrkPts[I];
      setlength(TrkPts,length(TrkPts)-Listbox3.ItemIndex);
      Name:=Name+'>';
    end;
  end;
  ZeichneTRKs;
end;

procedure tForm1.Button4Click(Sender: TObject);
var
  i: integer;
begin
  if Listbox1.ItemIndex<0 then exit;
  if Listbox2.ItemIndex<0 then exit;
  with D.GPX[Listbox1.ItemIndex] do begin
    for I:=Listbox2.ItemIndex+1 to length(Trks)-1 do
      Trks[I-1]:=Trks[I];
    setlength(Trks,length(Trks)-1);
    ZeichneTRKs;
  end;
end;

procedure tForm1.FormResize(Sender: TObject);
begin
  Listbox3.Height:=Form1.ClientHeight-Listbox3.Top;
  Zeichne;
end;

procedure tForm1.ListBox1Click(Sender: TObject);
begin
  ZeichneTRKs;
end;

procedure tForm1.ListBox2Click(Sender: TObject);
begin
  ZeichneTRKPTs;
end;

procedure tForm1.ListBox3Click(Sender: TObject);
begin
  Zeichne;
end;

procedure tForm1.zeichneGpxs;
var
  i: integer;
begin
  Listbox1.Items.Clear;
  for I:=0 to length(D.GPX)-1 do
    Listbox1.Items.Add(D.GPX[I].Kopf);
  ZeichneTRKs;
end;

procedure tForm1.zeichneTrks;
var
  i: integer;
begin
  Listbox2.Items.Clear;
  if Listbox1.ItemIndex>=0 then
    for i:=0 to length(D.GPX[Listbox1.ItemIndex].Trks)-1 do
      Listbox2.Items.Add(D.GPX[Listbox1.ItemIndex].Trks[I].Name);
  ZeichneTRKPTs;
end;

procedure tForm1.zeichneTrkPts;
var
  i: integer;
begin
  Listbox3.Items.Clear;
  if (Listbox1.ItemIndex>=0) and (Listbox2.ItemIndex>=0) then
    For I:=0 to length(D.GPX[Listbox1.ItemIndex].Trks[Listbox2.ItemIndex].TrkPts)-1 do
      Listbox3.Items.Add(D.GPX[Listbox1.ItemIndex].Trks[Listbox2.ItemIndex].TrkPts[I].lat+' '+
                         D.GPX[Listbox1.ItemIndex].Trks[Listbox2.ItemIndex].TrkPts[I].lon+' '+
                         D.GPX[Listbox1.ItemIndex].Trks[Listbox2.ItemIndex].TrkPts[I].time+' '+
                         D.GPX[Listbox1.ItemIndex].Trks[Listbox2.ItemIndex].TrkPts[I].ele);
  Zeichne;
end;

procedure tForm1.zeichne;
var
  I,TI:    Integer;
  Xmi,Xma,
  Ymi,Yma,
  tx,ty:   extended;
begin
  Image1.Free;
  Image1:=TImage.Create(Form1);
  Image1.Parent:=Form1;
  Image1.Left:=344;
  Image1.Top:=0;
  Image1.Width:=Form1.ClientWidth-Image1.Left;
  Image1.Height:=Form1.ClientHeight-Image1.Top;
  Image1.Canvas.Rectangle(-10,-10,Image1.Width+10,Image1.Height+10);
  if Listbox1.ItemIndex<0 then exit;
  XMi:=0;
  XMa:=0;
  YMi:=0;
  YMa:=0;
  for TI:=0 to Listbox2.Items.Count-1 do
   for I:=0 to length(D.GPX[Listbox1.Itemindex].Trks[TI].TrkPts)-1 do
    with D.GPX[Listbox1.Itemindex].Trks[TI].TrkPts[I] do
     begin
      tx:=mystrtofloat(lon);
      ty:=mystrtofloat(lat);
      if ((TI=0) and (I=0)) or (tx<xMi) then xMi:=tx;
      if ((TI=0) and (I=0)) or (tx>xMa) then xMa:=tx;
      if ((TI=0) and (I=0)) or (ty<yMi) then yMi:=ty;
      if ((TI=0) and (I=0)) or (ty>yMa) then yMa:=ty;
     end;
  xMa:=(Image1.Width-4)/max(1e-10,xMa-xMi);
  yMi:=(Image1.Height-4)/max(1e-10,yMa-yMi);
  for TI:=0 to Listbox2.Items.Count-1 do
   begin
    Image1.Canvas.Pen.Width:=1+2*Byte(TI=Listbox2.ItemIndex);
    Image1.Canvas.Pen.Color:=gibFarbe(TI);
    for I:=0 to length(D.GPX[Listbox1.Itemindex].Trks[TI].TrkPts)-1 do
     with D.GPX[Listbox1.Itemindex].Trks[TI].TrkPts[I] do
      begin
       tx:=2+(mystrtofloat(lon)-xMi)*xMa;
       ty:=2+(yMa-mystrtofloat(lat))*yMi;
       if I=0 then Image1.Canvas.MoveTo(round(tx),round(ty))
              else Image1.Canvas.LineTo(round(tx),round(ty));
      end;
    Image1.Canvas.Pen.Width:=1;
    Image1.Canvas.Pen.Color:=$000000;
   end;
  if Listbox2.ItemIndex<0 then exit;
  if Listbox3.ItemIndex<0 then exit;
  with D.GPX[Listbox1.Itemindex].Trks[Listbox2.ItemIndex].TrkPts[Listbox3.ItemIndex] do
   begin
    tx:=2+(mystrtofloat(lon)-xMi)*xMa;
    ty:=2+(yMa-mystrtofloat(lat))*yMi;
   end;
  Image1.Canvas.MoveTo(round(tx),round(ty)-4);
  Image1.Canvas.LineTo(round(tx),round(ty)+5);
  Image1.Canvas.MoveTo(round(tx)-4,round(ty));
  Image1.Canvas.LineTo(round(tx)+5,round(ty));
end;

end.