{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       GPS implementation  (VCL)                       }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 10 Dec 2009                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}

unit nrgps;

interface
uses classes, windows, sysutils, nrdataproc;

Type

  TnrGpsCommands =
  (
        gpsAAM,    // Waypoint Arrival Alarm
        gpsALM,    // Almanac data
        gpsAPA,    // Auto Pilot A sentence
        gpsAPB,    // Auto Pilot B sentence
        gpsBOD,    // Bearing Origin to Destination
        gpsBWC,    // Bearing using Great Circle route
        gpsDTM,    // Datum being used.
        gpsGGA,    // Fix information
        gpsGLL,    // Lat/Lon data
        gpsGRS,    // GPS Range Residuals
        gpsGSA,    // Overall Satellite data
        gpsGST,    // GPS Pseudorange Noise Statistics
        gpsGSV,    // Detailed Satellite data
        gpsMSK,    // send control for a beacon receiver
        gpsMSS,    // Beacon receiver status information.
        gpsRMA,    // recommended Loran data
        gpsRMB,    // recommended navigation data for gps
        gpsRMC,    // recommended minimum data for gps
        gpsRTE,    // route message
        gpsTRF,    // Transit Fix Data
        gpsSTN,    // Multiple Data ID
        gpsVBW,    // dual Ground / Water Spped
        gpsVTG,    // Vector track an Speed over the Ground
        gpsWCV,    // Waypoint closure velocity (Velocity Made Good)
        gpsWPL,    // Waypoint Location information
        gpsXTC,    // cross track error
        gpsXTE,    // measured cross track error
        gpsZTG,    // Zulu (UTC) time and time to go (to destination)
        gpsZDA,    // Date and Time

        // for internal use  ...
        gpsMulticommand
  );

  /// <summary>
  /// Geo coordinate
  /// </summary>
  TnrGpsCoordinate = packed record
    Latitude : single;
    Longitude : single;
    Altitude : single;
    GeoidHeight : single;
  end;

  /// <summary>
  /// Information about navigation satellite
  /// </summary>
  TnrGpsSatellite = packed record
    No : integer;
    Elevation : single;
    Azimuth : single;
    SNR : single;
    Used : boolean;
  end;
  PnrGpsSatellite = ^TnrGpsSatellite;

  /// <summary>
  /// Course (track) and speed information
  /// </summary>
  TnrGpsCourse = packed record
    Speed : single;
    SpeedN : single;
    Track :single;
    MagneticTrack : single;
  end;

  /// <summary>
  /// Quality and precision information
  /// </summary>
  TnrGpsQuality  = packed record
    Satellites : integer;
    Valid : boolean;
    DOP : single;
    HDOP :single;
    VDOP : single;
  end;

  TnrGpsPacketEvent = procedure(Sender:TObject; Command:TnrGpsCommands; Fields:TStrings; var Skip:boolean) of object;
  TnrGpsCoordinateEvent = procedure(Sender:TObject; Coordinate:TnrGpsCoordinate;  Course: TnrGpsCourse; Quality:TnrGpsQuality) of object;

  TnrGps = class (TnrDataProtocol)
  private
    fOnError: TNotifyEvent;
    fOnChangeState: TNotifyEvent;
    fVerifyChecksum: boolean;
    fOnlyValidInfo : boolean;
    currentCmdFields : TStrings;
    currentCmd: TnrGpsCommands;
    fCoordinateNew: TnrGpsCoordinate;
    fCoordinateCurrent: TnrGpsCoordinate;
    fCourseCurrent : TnrGpsCourse;
    fCourseNew : TnrGpsCourse;
    fQualityNew : TnrGpsQuality;
    fQualityCurrent : TnrGpsQuality;
    slSatellites:TStringList;
    slUsedSatellites:TStrings;

    fOnGpPacket: TnrGpsPacketEvent;
    fOnlyChanges:boolean;
    pendingChanges : boolean;
    fOnCoordinate: TnrGpsCoordinateEvent;
    fOnSatellite: TNotifyEvent;

    function GetVerifyChecksum: boolean;
    procedure SetVerifyChecksum(const Value: boolean);
    procedure AddPacket(cmd: TnrGpsCommands);
    function IsChecksumValid(const data:string):boolean;
    function GetOnlyValidInfo: boolean;
    procedure SetOnlyValidInfo(const Value: boolean);
    function DecodeFloatValue(val: string): single;
    function DecodeCoordinateValue(val, side: string): single;
    function GetOnlyChanges: boolean;
    procedure SetOnlyChanges(const Value: boolean);
    procedure ClearSatellites;
    function GetSatteliteCount:integer;
    function GetSatellites(Index:integer):TnrGpsSatellite;

  protected
    procedure DoHandlePacket(i:integer); override;
    function DoError:boolean; virtual;
    procedure HandleInvalidChecksum;
    procedure HandleGpsPacket(cmd: TnrGpsCommands; cmdFields:TStrings);
    procedure HandleGpsGGA(fields:TStrings);
    procedure HandleGpsRMC(fields:TStrings);
    procedure HandleGpsGSV(fields:TStrings);
    procedure HandleGpsVTG(fields:TStrings);
    procedure HandleGpsGSA(fields:TStrings);

    procedure HandleChanges(deferredChanges : boolean);

    procedure SetCoordinate(value : TnrGpsCoordinate);
    procedure SetCourse(value : TnrGpsCourse);
    procedure SetQuality(value: TnrGpsQuality);

    property OnError:TNotifyEvent read fOnError write fOnError;
    property OnChangeState:TNotifyEvent read fOnChangeState write fOnChangeState;

  public

    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property Coordinate: TnrGpsCoordinate read fCoordinateCurrent;
    property Course: TnrGpsCourse read fCourseCurrent;
    property Quality: TnrGpsQuality read fQualityCurrent;
    property Satellites[Index:integer]:TnrGpsSatellite read GetSatellites;
    property SatelliteCount:integer read GetSatteliteCount;

  published

    property VerifyChecksum:boolean read GetVerifyChecksum write SetVerifyChecksum;
    property OnlyValidInfo:boolean read GetOnlyValidInfo write SetOnlyValidInfo;
    property OnlyChanges:boolean read GetOnlyChanges write SetOnlyChanges;

    property Active;
    property Log;
    property OnGpPacket:TnrGpsPacketEvent read fOnGpPacket write fOnGpPacket;
    property OnCoordinate:TnrGpsCoordinateEvent read fOnCoordinate write fOnCoordinate;
    property OnSatellite:TNotifyEvent read fOnSatellite write fOnSatellite;

  end;

implementation
uses nrclasses, nrsysutils;

var
  GPS_PREFIX : array [TnrGpsCommands] of string =
  (
        'AAM',
        'ALM',
        'APA',
        'APB',
        'BOD',
        'BWC',
        'DTM',
        'GGA',
        'GLL',
        'GRS',
        'GSA',
        'GST',
        'GSV',
        'MSK',
        'MSS',
        'RMA',
        'RMB',
        'RMC',
        'RTE',
        'TRF',
        'STN',
        'VBW',
        'VTG',
        'WCV',
        'WPL',
        'XTC',
        'XTE',
        'ZTG',
        'ZDA',
        // for internal use  ...
        'Multicommand'
  );


{ TnrGps }

constructor TnrGps.Create(AOwner: TComponent);
var cmd:TnrGpsCommands;
begin
  inherited;
  slSatellites := TStringList.Create;
  slUsedSatellites := TStringList.Create;

  VerifyChecksum := true;
  currentCmdFields := TStringList.Create;
  //currentCmdFields.Delimiter := ',';

  // add needed NIMEA packets ...

  with DataPackets.Add do begin
    Caption := 'Multicommand';
    PacketBegin := AnsiChar(#13) + AnsiChar(#10);
    PacketEnd := AnsiString('&');
    Tag := Integer(gpsMulticommand);
  end;

  for cmd := Low(TnrGpsCommands) to High(TnrGpsCommands) do
    if cmd <> gpsMulticommand
      then AddPacket(cmd);
end;

destructor TnrGps.Destroy;
begin
  ClearSatellites();
  currentCmdFields.Free;
  slSatellites.Free;
  slUsedSatellites.Free;
  inherited;
end;

procedure TnrGps.AddPacket(cmd: TnrGpsCommands);
var prefix:string;
begin
  prefix := GPS_PREFIX[cmd];

  // add GPS packet ...
  with DataPackets.Add do begin
    Caption := prefix;
    Tag := Integer(cmd);
    PacketBegin := AnsiString('$GP' + prefix);
    PacketEnd := AnsiString(#13#10);
  end;

  // add GLONAS packet ...
  with DataPackets.Add do begin
    Caption := prefix;
    Tag := Integer(cmd);
    PacketBegin := AnsiString('$GL' + prefix);
    PacketEnd := AnsiString(#13#10);
  end;

end;

function  TnrGps.DoError : boolean;
begin
  Result := True;
{
  Inc(fErrors);
  Result := Errors <= ErrorLimit;

  if Result then begin
    if Assigned(fOnError) then fOnError(Self);
  end else begin
    Abort();
    DoFatalErrors(ECC_FTBASE, ECCE_TO_MANY_ERRORS, 'Too many errors.');
  end;
}
end;

procedure TnrGps.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then begin
    {$IFDEF NR_WITH_CONTROLS}
    //if AComponent = fProgressBar then fProgressBar := nil;
    {$ENDIF}
  end;
end;

function TnrGps.GetVerifyChecksum: boolean;
begin
  Result := fVerifyChecksum;
end;

procedure TnrGps.SetVerifyChecksum(const Value: boolean);
begin
  fVerifyChecksum := Value;
end;

function TnrGps.GetOnlyValidInfo: boolean;
begin
  Result := fOnlyValidInfo;
end;

procedure TnrGps.SetOnlyValidInfo(const Value: boolean);
begin
  fOnlyValidInfo := Value;
end;

function TnrGps.GetOnlyChanges: boolean;
begin
  Result := fOnlyChanges;
end;

procedure TnrGps.SetOnlyChanges(const Value: boolean);
begin
  fOnlyChanges := Value;
end;

procedure TnrGps.SetCoordinate(value: TnrGpsCoordinate);
var notify:boolean;
begin
  notify := not OnlyChanges or (not CompareMem(@fCoordinateCurrent,@value, SizeOf(TnrGpsCoordinate)));
  fCoordinateCurrent := value;
  if notify then HandleChanges(true);
end;

procedure TnrGps.SetCourse(value: TnrGpsCourse);
var notify:boolean;
begin
  notify := not OnlyChanges or (not CompareMem(@fCourseCurrent,@value, SizeOf(TnrGpsCourse)));
  fCourseCurrent := value;
  if notify then HandleChanges(true);
end;

procedure TnrGps.SetQuality(value: TnrGpsQuality);
var notify:boolean;
begin
  notify := not OnlyChanges or (not CompareMem(@fQualityCurrent,@value, SizeOf(TnrGpsQuality)));
  fQualityCurrent := value;
  if notify then HandleChanges(true);
end;

procedure TnrGps.HandleChanges(deferredChanges: boolean);
begin
  if deferredChanges
    then pendingChanges := true
    else
      if pendingChanges and Assigned(OnCoordinate) then begin
        pendingChanges := false;
        try
          OnCoordinate(self, fCoordinateCurrent,  fCourseCurrent, fQualityCurrent);
        except

        end;
      end;
end;

function TnrGps.GetSatellites(Index: integer): TnrGpsSatellite;
begin
  Result := PnrGpsSatellite(slSatellites.Objects[Index])^;
end;

function TnrGps.GetSatteliteCount: integer;
begin
  Result := slSatellites.Count;
end;

function TnrGps.DecodeFloatValue(val : string) : single;
begin
  if length(val) = 0 then
    Result := 0
  else begin
    if DecimalSeparator <> '.'
      then val := StringReplace(val, '.', DecimalSeparator, []);
    try
      Result := StrToFloat(val);
    except
      Result := 0;
    end;
  end;
end;

function TnrGps.DecodeCoordinateValue(val, side : string):single;
begin
  Result := DecodeFloatValue(val);
  if (Length(side) > 0) and ((side[1] = 'S') or (side[1] = 'W') or
     (side[1] = 's') or (side[1] = 'w'))
    then Result := Result * -1;
end;

procedure TnrGps.DoHandlePacket(i: integer);
var data : String;
    packet : TnrDataPacket;
    skip:boolean;
begin
  packet := DataPackets[i];
  try
    data := Trim(String(packet.Data));

    if VerifyChecksum and not IsChecksumValid(data) then begin
      HandleInvalidChecksum();
      exit;
    end;

    currentCmd := TnrGpsCommands(packet.Tag);
    //currentCmdFields.DelimitedText := Copy(data, 1, Length(data) - 3);
    currentCmdFields.Text := StringReplace(Copy(data, 1, Length(data) - 3), ',',#13#10,[rfReplaceAll]) + '0';

    Logging(dlDebug, packet.Caption);

    if Assigned(fOnGpPacket) then begin
      skip := false;
      fOnGpPacket(self, currentCmd, currentCmdFields, skip);
      if skip then exit;
    end;

    HandleGpsPacket(currentCmd, currentCmdFields);

    inherited;
  except
    on E:Exception do DoFatalErrors(ECC_GPS, 1,
         'EXCEPTION in GpsPacket handler [' + packet.DisplayName + '] ' +
         E.Message);
  end;

end;

function TnrGps.IsChecksumValid(const data:string):boolean;
var i, len : integer;
    crc : byte;
begin
  Result := False;
  len := Length(data);
  if (len < 5) or (data[1] <> '$') or (data[len - 2] <> '*') then exit; // threre is no gsm packet!  return OK.
  crc := 0;
  for i := 2 to len - 3 do crc := crc xor Byte(data[i]);
  Result := CompareText(IntToHex(crc,2), Copy(data, len - 1, 2)) = 0;
end;


procedure TnrGps.HandleInvalidChecksum();
begin

end;

procedure TnrGps.HandleGpsPacket(cmd: TnrGpsCommands; cmdFields: TStrings);
begin
  // OutputDebugString(PChar('' + cmdFields.Text));

  case cmd of
    gpsGGA: HandleGpsGGA(cmdFields);
    gpsRMC: HandleGpsRMC(cmdFields);
    gpsGSV: HandleGpsGSV(cmdFields);
    gpsVTG: HandleGpsVTG(cmdFields);
    gpsGSA: HandleGpsGSA(cmdFields);
  end;

end;

procedure TnrGps.HandleGpsGGA(fields: TStrings);
begin
  if fields.Count < 15 then exit;

  // skip invalid packets if needed
  if OnlyValidInfo and  (fields[3] = '0') then exit;

  // decode coordinate info
  fCoordinateNew.Latitude := DecodeCoordinateValue(fields[2], fields[3]);
  fCoordinateNew.Longitude := DecodeCoordinateValue(fields[4], fields[5]);
  fCoordinateNew.Altitude := DecodeFloatValue(fields[9]);
  fCoordinateNew.GeoidHeight := DecodeFloatValue(fields[11]);

  // decode quality info
  fQualityNew.Satellites := StrToIntDef(fields[7], 0);
  fQualityNew.Valid := fields[3] <> '0';

  SetCoordinate(fCoordinateNew);
  SetQuality(fQualityNew);

  HandleChanges(false);

end;

procedure TnrGps.HandleGpsRMC(fields: TStrings);
begin
  if fields.Count < 12 then exit;

  // skip invalid packets if needed
  if OnlyValidInfo and  (fields[2] <> 'A') then exit;

  // decode coordinate info
  fCoordinateNew.Latitude := DecodeCoordinateValue(fields[3], fields[4]);
  fCoordinateNew.Longitude := DecodeCoordinateValue(fields[5], fields[6]);

  // decode quality info
  fQualityNew.Valid := fields[2] = 'A';

  // decode track info
  fCourseNew.SpeedN := DecodeFloatValue(fields[7]);
  fCourseNew.Track := DecodeFloatValue(fields[8]);

  SetCoordinate(fCoordinateNew);
  SetCourse(fCourseNew);
  SetQuality(fQualityNew);

  HandleChanges(false);

end;

procedure TnrGps.HandleGpsGSV(fields: TStrings);
var i, totalCount, no:integer;
    ufo : PnrGpsSatellite;
begin
  if fields.Count < 5 then exit;

  totalCount := StrToIntDef(fields[3],0);
  if totalCount <= 0 then exit;

  // clear current satellite list for first sentence
  if fields[2] = '1'
     then ClearSatellites;

  i := 4;

  while (i < 20) and ((i + 3) < fields.Count) do begin
    no := StrToIntDef(fields[i], -1);
    if no >= 0 then begin
      New(ufo);
      ufo^.No := no;
      ufo^.Elevation := DecodeFloatValue(fields[i + 1]);
      ufo^.Azimuth :=  DecodeFloatValue(fields[i + 2]);
      ufo^.SNR := DecodeFloatValue(fields[i + 3]);
      ufo^.Used := slUsedSatellites.IndexOf(fields[i]) >= 0;
      slSatellites.AddObject(fields[i], TObject(ufo));
      if slSatellites.Count >= totalCount then break;
    end;
    Inc(i, 4);
  end;

  // is it last sentence?
  if Assigned(OnSatellite) and (fields[1] = fields[2]) then begin
    slSatellites.Sort();
    OnSatellite(self);
  end;

end;

procedure TnrGps.HandleGpsVTG(fields: TStrings);
begin
  if fields.Count < 5 then exit;

  //  decode track info
  fCourseNew.Track := DecodeFloatValue(fields[1]);
  fCourseNew.MagneticTrack := DecodeFloatValue(fields[3]);
  fCourseNew.SpeedN := DecodeFloatValue(fields[5]);
  fCourseNew.Speed := DecodeFloatValue(fields[7]);

  SetCourse(fCourseNew);
  HandleChanges(false);

end;

procedure TnrGps.HandleGpsGSA(fields: TStrings);
var i:integer;
begin
  if fields.Count < 18 then exit;

  fQualityNew.DOP := DecodeFloatValue(fields[15]);
  fQualityNew.HDOP := DecodeFloatValue(fields[16]);
  fQualityNew.VDOP := DecodeFloatValue(fields[17]);

  slUsedSatellites.Clear;
  for i := 3 to 14 do
    slUsedSatellites.Add(fields[i]);

  SetQuality(fQualityNew);

  HandleChanges(false);

end;

procedure TnrGps.ClearSatellites;
var i:integer;
begin
  for i := 0 to slSatellites.Count - 1
    do Dispose(PnrGpsSatellite(slSatellites.Objects[i]));
  slSatellites.Clear();
end;

end.
