GPS Exchange Format library/CLI in OCaml
anil.recoil.org
1(** Route types and operations *)
2
3(** Route point is an alias for waypoint *)
4type point = Waypoint.t
5
6(** Main route type *)
7type t = {
8 name : string option;
9 cmt : string option;
10 desc : string option;
11 src : string option;
12 links : Link.t list;
13 number : int option;
14 type_ : string option;
15 extensions : Extension.t list;
16 rtepts : point list;
17}
18
19(** {2 Route Operations} *)
20
21(** Create empty route *)
22let empty = {
23 name = None; cmt = None; desc = None; src = None;
24 links = []; number = None; type_ = None; extensions = [];
25 rtepts = [];
26}
27
28(** Create route with name *)
29let make ~name = { empty with name = Some name }
30
31(** Create route from coordinate list *)
32let make_from_coords ~name coords =
33 let make_rtept (lat_f, lon_f) =
34 match Waypoint.make_from_floats ~lat:lat_f ~lon:lon_f () with
35 | Ok wpt -> wpt
36 | Error e -> invalid_arg e
37 in
38 let rtepts = List.map make_rtept coords in
39 { empty with name = Some name; rtepts }
40
41(** Get route name *)
42let name t = t.name
43
44(** Get route description *)
45let description t = t.desc
46
47(** Get route number *)
48let number t = t.number
49
50(** Get route comment *)
51let comment t = t.cmt
52
53(** Get route source *)
54let source t = t.src
55
56(** Get route links *)
57let links t = t.links
58
59(** Get route type *)
60let type_ t = t.type_
61
62(** Get route extensions *)
63let extensions t = t.extensions
64
65(** Get route points *)
66let points t = t.rtepts
67
68(** Get route point count *)
69let point_count t = List.length t.rtepts
70
71
72(** Clear all points *)
73let clear_points t = { t with rtepts = [] }
74
75(** Extract coordinates from route *)
76let to_coords t = List.map Waypoint.to_floats t.rtepts
77
78(** Simple great circle distance calculation *)
79let great_circle_distance lat1 lon1 lat2 lon2 =
80 let deg_to_rad x = x *. Float.pi /. 180.0 in
81 let lat1_rad = deg_to_rad lat1 in
82 let lon1_rad = deg_to_rad lon1 in
83 let lat2_rad = deg_to_rad lat2 in
84 let lon2_rad = deg_to_rad lon2 in
85 let dlat = lat2_rad -. lat1_rad in
86 let dlon = lon2_rad -. lon1_rad in
87 let a =
88 sin (dlat /. 2.0) ** 2.0 +.
89 cos lat1_rad *. cos lat2_rad *. sin (dlon /. 2.0) ** 2.0
90 in
91 let c = 2.0 *. asin (sqrt a) in
92 6371000.0 *. c (* Earth radius in meters *)
93
94(** Calculate total distance between consecutive points (naive great circle) *)
95let total_distance t =
96 let rec calculate_distance acc = function
97 | [] | [_] -> acc
98 | p1 :: p2 :: rest ->
99 let lat1, lon1 = Waypoint.to_floats p1 in
100 let lat2, lon2 = Waypoint.to_floats p2 in
101 let distance = great_circle_distance lat1 lon1 lat2 lon2 in
102 calculate_distance (acc +. distance) (p2 :: rest)
103 in
104 calculate_distance 0.0 t.rtepts
105
106(** Check if route is empty *)
107let is_empty t = List.length t.rtepts = 0
108
109(** Get first point *)
110let first_point t =
111 match t.rtepts with
112 | [] -> None
113 | p :: _ -> Some p
114
115(** Get last point *)
116let last_point t =
117 match List.rev t.rtepts with
118 | [] -> None
119 | p :: _ -> Some p
120
121(** {2 Functional Operations} *)
122
123(** Update name *)
124let with_name t name = { t with name = Some name }
125
126(** Update comment *)
127let with_comment t cmt = { t with cmt = Some cmt }
128
129(** Update description *)
130let with_description t desc = { t with desc = Some desc }
131
132(** Update source *)
133let with_source t src = { t with src = Some src }
134
135(** Update number *)
136let with_number t number = { t with number = Some number }
137
138(** Update type *)
139let with_type t type_ = { t with type_ = Some type_ }
140
141(** Add point *)
142let add_point t rtept = { t with rtepts = t.rtepts @ [rtept] }
143
144(** Add link *)
145let add_link t link = { t with links = t.links @ [link] }
146
147(** Add extensions *)
148let add_extensions t extensions = { t with extensions = t.extensions @ extensions }
149
150(** Compare routes *)
151let compare t1 t2 =
152 let name_cmp = Option.compare String.compare t1.name t2.name in
153 if name_cmp <> 0 then name_cmp
154 else
155 let desc_cmp = Option.compare String.compare t1.desc t2.desc in
156 if desc_cmp <> 0 then desc_cmp
157 else List.compare Waypoint.compare t1.rtepts t2.rtepts
158
159(** Test route equality *)
160let equal t1 t2 = compare t1 t2 = 0
161
162(** Pretty print route *)
163let pp ppf t =
164 match t.name with
165 | Some name -> Format.fprintf ppf "\"%s\" (%d points)" name (point_count t)
166 | None -> Format.fprintf ppf "(unnamed route, %d points)" (point_count t)