path: root/valuesunit.pas

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: tInt64Point; dat: string); overload;
    procedure readFromFile(minT,maxT: int64; dat: string); overload;
    function count: int64;
    function timeInterval: tInt64Point;
    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
  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(low(int64),high(int64),dat);
end;

procedure tValues.readFromFile(ti: tInt64Point; dat: string);
begin
  readFromFile(ti['x'],ti['y'],dat);
end;

procedure tValues.readFromFile(minT,maxT: int64; 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: tInt64Point;
begin
  if count=0 then begin
    result['x']:=high(int64);
    result['y']:=low(int64);
  end
  else begin
    result['x']:=werte[0].time;
    result['y']:=werte[count-1].time;
  end;
end;

procedure tValues.intersect(v: tValues);
var
  i,t: int64;
begin
  if (count=0) or (v.count=0) or (timeInterval=v.timeInterval) then
    exit;
  t:=v.timeInterval['x'];
  i:=0;
  while (i<count) and (werte[i].time<t) do
    inc(i);
  if i>0 then begin
    for t:=i to count-1 do
      werte[t-i]:=werte[t];
    setlength(werte,count-i);
  end;

  t:=v.timeInterval['y'];
  while (count>0) and (werte[count-1].time>t) do
    setlength(werte,length(werte)-1);

  v.intersect(self);
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]:=
      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.