1 files changed, 236 insertions, 0 deletions
diff --git a/valuesunit.pas b/valuesunit.pas
new file mode 100644
index 0000000..97d960f
--- /dev/null
+++ b/valuesunit.pas
@@ -0,0 +1,236 @@
+unit valuesunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, lowlevelunit;
+
+type
+  tWert = record
+    time: int64; // unix timestamp * 1000
+    vec:  array['x'..'z'] of extended;
+  end;
+
+  tValues = class
+  private
+    werte: array of tWert;
+  public
+    constructor create;
+    destructor destroy; override;
+    procedure readFromFile(dat: string); overload;
+    procedure readFromFile(ti: tExtPoint; dat: string); overload;
+    procedure readFromFile(minT,maxT: extended; dat: string); overload;
+    function count: int64;
+    function timeInterval: tExtPoint;
+    procedure intersect(v: tValues);
+  end;
+
+function interpolate(w1,w2: tWert; x: extended): tWert; inline;
+function isoStrToDateTime(s: string): extended; inline;
+function timeToInt64(s: string): int64;
+
+implementation
+
+uses
+  math, dateutils;
+
+constructor tValues.create;
+begin
+  inherited create;
+  setlength(werte,0);
+end;
+
+destructor tValues.destroy;
+begin
+  setlength(werte,0);
+  inherited destroy;
+end;
+
+procedure tValues.readFromFile(dat: string);
+begin
+  readFromFile(-infinity,infinity,dat);
+end;
+
+procedure tValues.readFromFile(ti: tExtPoint; dat: string);
+begin
+  readFromFile(ti['x'],ti['y'],dat);
+end;
+
+procedure tValues.readFromFile(minT,maxT: extended; dat: string);
+var
+  f:           textfile;
+  s:           string;
+  i,delta,cnt: int64;
+  ws:          tWert;
+  c:           char;
+  isXml:       boolean;
+begin
+  setlength(werte,0);
+  fillchar(ws,sizeOf(tWert),0);
+  cnt:=0;
+  assignFile(f,dat);
+  reset(f);
+  isXml:=false;
+  s:='';
+  while (s<>'') or not eof(f) do begin
+    if s='' then
+      readln(f,s);
+    if s='' then
+      continue;
+
+    if (not isXml) and (not (s[1] in ['0'..'9'])) then begin
+      if copy(s,1,6)='<?xml ' then
+        isXml:=true
+      else begin
+        s:='';
+        continue;
+      end;
+    end;
+
+    if isXml then begin
+      if pos('<trkpt lat="',s)=0 then begin
+        s:='';
+        continue;
+      end;
+
+      delete(s,1,pos('<trkpt lat="',s));
+      delete(s,1,pos('"',s));
+      ws.vec['y']:=strtofloat(erstesArgument(s,'" '));
+      if pos('lon="',s)<>1 then
+        raise exception.create('Syntax error in '''+dat+''' (lon) - no valid gpx file.'#10'Hickup: '''+copy(s,1,40)+' ...''');
+      delete(s,1,pos('"',s));
+      ws.vec['x']:=strtofloat(erstesArgument(s,'"'));
+      if pos('><ele>',s)<>1 then
+        raise exception.create('Syntax error in '''+dat+''' (lat) - no valid gpx file.'#10'Hickup: '''+copy(s,1,40)+' ...''');
+      delete(s,1,pos('>',s));
+      delete(s,1,pos('>',s));
+      ws.vec['z']:=strtofloat(erstesArgument(s,'<'));
+      if pos('/ele><time>',s)<>1 then
+        raise exception.create('Syntax error in '''+dat+''' (ele) - no valid gpx file.'#10'Hickup: '''+copy(s,1,40)+' ...''');
+      delete(s,1,pos('>',s));
+      delete(s,1,pos('>',s));
+      ws.time:=timeToInt64(erstesArgument(s,'<'));
+      if pos('/time>',s)<>1 then
+        raise exception.create('Syntax error in '''+dat+''' (time) - no valid gpx file.'#10'Hickup: '''+copy(s,1,40)+' ...''');
+    end
+    else begin
+      ws.time:=strtoint64(erstesArgument(s,';'));
+      erstesArgument(s,';');
+      for c:='x' to 'z' do
+        ws.vec[c]:=strtofloat(erstesArgument(s,';'));
+      s:='';
+    end;
+
+    if cnt>0 then
+      delta:=ws.time-werte[cnt-1].time
+    else
+      delta:=1;
+
+    cnt:=cnt+delta;
+    if cnt>=length(werte) then
+      setlength(werte,cnt+64*1024);
+    if cnt>=length(werte) then
+      raise exception.create('Failed to enlarge array.');
+
+    if delta=1 then
+      move(ws,werte[cnt-1],sizeOf(tWert))
+    else
+      for i:=delta-1 downto 0 do
+        werte[cnt-i-1]:=
+          interpolate(
+            werte[cnt-delta-1],
+            ws,
+            (delta-i)/delta
+          );
+
+    if werte[0].time<minT then begin
+      delta:=cnt-1;
+      while (werte[delta].time>=minT) and (delta>0) do
+        dec(delta);
+      for i:=delta to cnt-1 do
+        move(werte[i],werte[i-delta],sizeOf(tWert));
+      cnt:=cnt-delta;
+    end;
+
+    if werte[cnt-1].time>maxT then begin
+      while (cnt>0) and (werte[cnt-2].time>maxT) do
+        dec(cnt);
+      break;
+    end;
+  end;
+  closeFile(f);
+  setlength(werte,cnt);
+end;
+
+function tValues.count: int64;
+begin
+  result:=length(werte);
+end;
+
+function tValues.timeInterval: tExtPoint;
+begin
+  result['x']:=werte[0].time;
+  result['y']:=werte[count-1].time;
+end;
+
+procedure tValues.intersect(v: tValues);
+begin
+  if
+end;
+
+// general functions ***********************************************************
+
+function interpolate(w1,w2: tWert; x: extended): tWert; inline;
+var
+  c: char;
+begin
+  result.time:=
+    round(w1.time*(1-x) + w2.time*x);
+  for c:='x' to 'z' do begin
+    result.vec[c]:=
+      round(w1.vec[c]*(1-x) + w2.vec[c]*x);
+  end;
+end;
+
+function isoStrToDateTime(s: string): extended; inline;
+begin
+  if (length(s)<>19) or
+    (s[5]<>'-') or
+    (s[8]<>'-') or
+    (s[11]<>' ') or
+    (s[14]<>':') or
+    (s[17]<>':') then
+    raise exception.create(''''+s+''' is not a valid iso date-time');
+  result:=
+    encodeDate(
+      strToInt(copy(s,1,4)),
+      strToInt(copy(s,6,2)),
+      strToInt(copy(s,9,2))
+    ) +
+    encodeTime(
+      strToInt(copy(s,12,2)),
+      strToInt(copy(s,15,2)),
+      strToInt(copy(s,18,2)),
+      0
+    );
+end;
+
+function timeToInt64(s: string): int64;
+begin
+  if (length(s)<>20) or
+    (s[5]<>'-') or
+    (s[8]<>'-') or
+    (s[11]<>'T') or
+    (s[14]<>':') or
+    (s[17]<>':') or
+    (s[20]<>'Z') then
+    raise exception.create(''''+s+''' is not a valid date-time');
+  delete(s,20,1);
+  s[11]:=' ';
+  result:=round(dateTimeToUnix(isoStrToDateTime(s))*1000);
+end;
+
+end.
+