Source file waypoint.ml

(** Waypoint data and GPS fix types *)

(** GPS fix types as defined in GPX spec *)
type fix_type = 
  | None_fix
  | Fix_2d
  | Fix_3d
  | Dgps
  | Pps

(** Main waypoint type - shared by waypoints, route points, track points *)
type t = {
  lat : Coordinate.latitude;
  lon : Coordinate.longitude;
  ele : float option;
  time : Ptime.t option;
  magvar : Coordinate.degrees option;
  geoidheight : float option;
  name : string option;
  cmt : string option;
  desc : string option;
  src : string option;
  links : Link.t list;
  sym : string option;
  type_ : string option;
  fix : fix_type option;
  sat : int option;
  hdop : float option;
  vdop : float option;
  pdop : float option;
  ageofdgpsdata : float option;
  dgpsid : int option;
  extensions : Extension.t list;
}

(** {2 Fix Type Operations} *)

let fix_type_to_string = function
  | None_fix -> "none"
  | Fix_2d -> "2d" 
  | Fix_3d -> "3d"
  | Dgps -> "dgps"
  | Pps -> "pps"

let fix_type_of_string = function
  | "none" -> Some None_fix
  | "2d" -> Some Fix_2d
  | "3d" -> Some Fix_3d
  | "dgps" -> Some Dgps
  | "pps" -> Some Pps
  | _ -> None

let compare_fix_type f1 f2 = match f1, f2 with
  | None_fix, None_fix -> 0
  | None_fix, _ -> -1
  | _, None_fix -> 1
  | Fix_2d, Fix_2d -> 0
  | Fix_2d, _ -> -1
  | _, Fix_2d -> 1
  | Fix_3d, Fix_3d -> 0
  | Fix_3d, _ -> -1
  | _, Fix_3d -> 1
  | Dgps, Dgps -> 0
  | Dgps, _ -> -1
  | _, Dgps -> 1
  | Pps, Pps -> 0

(** {2 Waypoint Operations} *)

(** Create waypoint with required coordinates *)
let make lat lon = {
  lat; lon;
  ele = None; time = None; magvar = None; geoidheight = None;
  name = None; cmt = None; desc = None; src = None; links = [];
  sym = None; type_ = None; fix = None; sat = None;
  hdop = None; vdop = None; pdop = None; ageofdgpsdata = None;
  dgpsid = None; extensions = [];
}

(** Create waypoint from float coordinates *)
let make_from_floats ~lat ~lon ?name ?desc () =
  match Coordinate.latitude lat, Coordinate.longitude lon with
  | Ok lat_coord, Ok lon_coord -> 
    let wpt = make lat_coord lon_coord in
    Ok { wpt with name; desc }
  | Error e, _ | _, Error e -> Error e

(** Get coordinate pair *)
let coordinate t = Coordinate.make t.lat t.lon

(** Get latitude *)
let lat t = t.lat

(** Get longitude *)
let lon t = t.lon

(** Get coordinate as float pair *)
let to_floats t = (Coordinate.latitude_to_float t.lat, Coordinate.longitude_to_float t.lon)

(** Get elevation *)
let elevation t = t.ele

(** Get time *)
let time t = t.time

(** Get name *)
let name t = t.name

(** Get description *)
let description t = t.desc

(** Get comment *)
let comment t = t.cmt

(** Get source *)
let source t = t.src

(** Get symbol *)
let symbol t = t.sym

(** Get type *)
let type_ t = t.type_

(** Get fix type *)
let fix t = t.fix

(** Get satellite count *)
let sat t = t.sat

(** Get horizontal dilution of precision *)
let hdop t = t.hdop

(** Get vertical dilution of precision *)
let vdop t = t.vdop

(** Get position dilution of precision *)
let pdop t = t.pdop

(** Get magnetic variation *)
let magvar t = t.magvar

(** Get geoid height *)
let geoidheight t = t.geoidheight

(** Get age of DGPS data *)
let ageofdgpsdata t = t.ageofdgpsdata

(** Get DGPS ID *)
let dgpsid t = t.dgpsid

(** Get links *)
let links t = t.links

(** Get extensions *)
let extensions t = t.extensions

(** Update elevation *)
let with_elevation t ele = { t with ele = Some ele }

(** Update time *)
let with_time t time = { t with time }

(** Update name *)
let with_name t name = { t with name = Some name }

(** Update comment *)
let with_comment t cmt = { t with cmt = Some cmt }

(** Update description *)
let with_description t desc = { t with desc = Some desc }

(** Update source *)
let with_source t src = { t with src = Some src }

(** Update symbol *)
let with_symbol t sym = { t with sym = Some sym }

(** Update type *)
let with_type t type_ = { t with type_ = Some type_ }

(** Update fix *)
let with_fix t fix = { t with fix }

(** Update satellite count *)
let with_sat t sat = { t with sat = Some sat }

(** Update HDOP *)
let with_hdop t hdop = { t with hdop = Some hdop }

(** Update VDOP *)
let with_vdop t vdop = { t with vdop = Some vdop }

(** Update PDOP *)
let with_pdop t pdop = { t with pdop = Some pdop }

(** Update magnetic variation *)
let with_magvar t magvar = { t with magvar = Some magvar }

(** Update geoid height *)
let with_geoidheight t geoidheight = { t with geoidheight = Some geoidheight }

(** Update age of DGPS data *)
let with_ageofdgpsdata t ageofdgpsdata = { t with ageofdgpsdata = Some ageofdgpsdata }

(** Update DGPS ID *)
let with_dgpsid t dgpsid = { t with dgpsid = Some dgpsid }

(** Add link *)
let add_link t link = { t with links = link :: t.links }

(** Add extensions *)
let add_extensions t extensions = { t with extensions = extensions @ t.extensions }

(** Compare waypoints *)
let compare t1 t2 =
  let lat_cmp = Float.compare 
    (Coordinate.latitude_to_float t1.lat) 
    (Coordinate.latitude_to_float t2.lat) in
  if lat_cmp <> 0 then lat_cmp
  else
    let lon_cmp = Float.compare 
      (Coordinate.longitude_to_float t1.lon) 
      (Coordinate.longitude_to_float t2.lon) in
    if lon_cmp <> 0 then lon_cmp
    else
      let ele_cmp = Option.compare Float.compare t1.ele t2.ele in
      if ele_cmp <> 0 then ele_cmp
      else Option.compare Ptime.compare t1.time t2.time

(** Test waypoint equality *)
let equal t1 t2 = compare t1 t2 = 0

(** Pretty print waypoint *)
let pp ppf t =
  let lat, lon = to_floats t in
  match t.name with
  | Some name -> Format.fprintf ppf "%s @ (%g, %g)" name lat lon
  | None -> Format.fprintf ppf "(%g, %g)" lat lon

(** Pretty print fix type *)
let pp_fix_type ppf = function
  | None_fix -> Format.fprintf ppf "none"
  | Fix_2d -> Format.fprintf ppf "2d"
  | Fix_3d -> Format.fprintf ppf "3d" 
  | Dgps -> Format.fprintf ppf "dgps"
  | Pps -> Format.fprintf ppf "pps"