Source file route.ml

(** Route types and operations *)

(** Route point is an alias for waypoint *)
type point = Waypoint.t

(** Main route type *)
type t = {
  name : string option;
  cmt : string option;
  desc : string option;
  src : string option;
  links : Link.t list;
  number : int option;
  type_ : string option;
  extensions : Extension.t list;
  rtepts : point list;
}

(** {2 Route Operations} *)

(** Create empty route *)
let empty = {
  name = None; cmt = None; desc = None; src = None;
  links = []; number = None; type_ = None; extensions = [];
  rtepts = [];
}

(** Create route with name *)
let make ~name = { empty with name = Some name }

(** Create route from coordinate list *)
let make_from_coords ~name coords =
  let make_rtept (lat_f, lon_f) =
    match Waypoint.make_from_floats ~lat:lat_f ~lon:lon_f () with
    | Ok wpt -> wpt
    | Error e -> invalid_arg e
  in
  let rtepts = List.map make_rtept coords in
  { empty with name = Some name; rtepts }

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

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

(** Get route number *)
let number t = t.number

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

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

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

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

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

(** Get route points *)
let points t = t.rtepts

(** Get route point count *)
let point_count t = List.length t.rtepts


(** Clear all points *)
let clear_points t = { t with rtepts = [] }

(** Extract coordinates from route *)
let to_coords t = List.map Waypoint.to_floats t.rtepts

(** Simple great circle distance calculation *)
let great_circle_distance lat1 lon1 lat2 lon2 =
  let deg_to_rad x = x *. Float.pi /. 180.0 in
  let lat1_rad = deg_to_rad lat1 in
  let lon1_rad = deg_to_rad lon1 in
  let lat2_rad = deg_to_rad lat2 in
  let lon2_rad = deg_to_rad lon2 in
  let dlat = lat2_rad -. lat1_rad in
  let dlon = lon2_rad -. lon1_rad in
  let a = 
    sin (dlat /. 2.0) ** 2.0 +. 
    cos lat1_rad *. cos lat2_rad *. sin (dlon /. 2.0) ** 2.0 
  in
  let c = 2.0 *. asin (sqrt a) in
  6371000.0 *. c (* Earth radius in meters *)

(** Calculate total distance between consecutive points (naive great circle) *)
let total_distance t =
  let rec calculate_distance acc = function
    | [] | [_] -> acc
    | p1 :: p2 :: rest ->
      let lat1, lon1 = Waypoint.to_floats p1 in
      let lat2, lon2 = Waypoint.to_floats p2 in
      let distance = great_circle_distance lat1 lon1 lat2 lon2 in
      calculate_distance (acc +. distance) (p2 :: rest)
  in
  calculate_distance 0.0 t.rtepts

(** Check if route is empty *)
let is_empty t = List.length t.rtepts = 0

(** Get first point *)
let first_point t = 
  match t.rtepts with
  | [] -> None
  | p :: _ -> Some p

(** Get last point *)
let last_point t =
  match List.rev t.rtepts with
  | [] -> None
  | p :: _ -> Some p

(** {2 Functional Operations} *)

(** 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 number *)
let with_number t number = { t with number = Some number }

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

(** Add point *)
let add_point t rtept = { t with rtepts = t.rtepts @ [rtept] }

(** Add link *)
let add_link t link = { t with links = t.links @ [link] }

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

(** Compare routes *)
let compare t1 t2 =
  let name_cmp = Option.compare String.compare t1.name t2.name in
  if name_cmp <> 0 then name_cmp
  else
    let desc_cmp = Option.compare String.compare t1.desc t2.desc in
    if desc_cmp <> 0 then desc_cmp
    else List.compare Waypoint.compare t1.rtepts t2.rtepts

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

(** Pretty print route *)
let pp ppf t =
  match t.name with
  | Some name -> Format.fprintf ppf "\"%s\" (%d points)" name (point_count t)
  | None -> Format.fprintf ppf "(unnamed route, %d points)" (point_count t)