GPS Exchange Format library/CLI in OCaml
anil.recoil.org
1(** Waypoint data and GPS fix types *)
2
3(** GPS fix types as defined in GPX spec *)
4type fix_type =
5 | None_fix
6 | Fix_2d
7 | Fix_3d
8 | Dgps
9 | Pps
10
11(** Main waypoint type - shared by waypoints, route points, track points *)
12type t = {
13 lat : Coordinate.latitude;
14 lon : Coordinate.longitude;
15 ele : float option;
16 time : Ptime.t option;
17 magvar : Coordinate.degrees option;
18 geoidheight : float option;
19 name : string option;
20 cmt : string option;
21 desc : string option;
22 src : string option;
23 links : Link.t list;
24 sym : string option;
25 type_ : string option;
26 fix : fix_type option;
27 sat : int option;
28 hdop : float option;
29 vdop : float option;
30 pdop : float option;
31 ageofdgpsdata : float option;
32 dgpsid : int option;
33 extensions : Extension.t list;
34}
35
36(** {2 Fix Type Operations} *)
37
38let fix_type_to_string = function
39 | None_fix -> "none"
40 | Fix_2d -> "2d"
41 | Fix_3d -> "3d"
42 | Dgps -> "dgps"
43 | Pps -> "pps"
44
45let fix_type_of_string = function
46 | "none" -> Some None_fix
47 | "2d" -> Some Fix_2d
48 | "3d" -> Some Fix_3d
49 | "dgps" -> Some Dgps
50 | "pps" -> Some Pps
51 | _ -> None
52
53let compare_fix_type f1 f2 = match f1, f2 with
54 | None_fix, None_fix -> 0
55 | None_fix, _ -> -1
56 | _, None_fix -> 1
57 | Fix_2d, Fix_2d -> 0
58 | Fix_2d, _ -> -1
59 | _, Fix_2d -> 1
60 | Fix_3d, Fix_3d -> 0
61 | Fix_3d, _ -> -1
62 | _, Fix_3d -> 1
63 | Dgps, Dgps -> 0
64 | Dgps, _ -> -1
65 | _, Dgps -> 1
66 | Pps, Pps -> 0
67
68(** {2 Waypoint Operations} *)
69
70(** Create waypoint with required coordinates *)
71let make lat lon = {
72 lat; lon;
73 ele = None; time = None; magvar = None; geoidheight = None;
74 name = None; cmt = None; desc = None; src = None; links = [];
75 sym = None; type_ = None; fix = None; sat = None;
76 hdop = None; vdop = None; pdop = None; ageofdgpsdata = None;
77 dgpsid = None; extensions = [];
78}
79
80(** Create waypoint from float coordinates *)
81let make_from_floats ~lat ~lon ?name ?desc () =
82 match Coordinate.latitude lat, Coordinate.longitude lon with
83 | Ok lat_coord, Ok lon_coord ->
84 let wpt = make lat_coord lon_coord in
85 Ok { wpt with name; desc }
86 | Error e, _ | _, Error e -> Error e
87
88(** Get coordinate pair *)
89let coordinate t = Coordinate.make t.lat t.lon
90
91(** Get latitude *)
92let lat t = t.lat
93
94(** Get longitude *)
95let lon t = t.lon
96
97(** Get coordinate as float pair *)
98let to_floats t = (Coordinate.latitude_to_float t.lat, Coordinate.longitude_to_float t.lon)
99
100(** Get elevation *)
101let elevation t = t.ele
102
103(** Get time *)
104let time t = t.time
105
106(** Get name *)
107let name t = t.name
108
109(** Get description *)
110let description t = t.desc
111
112(** Get comment *)
113let comment t = t.cmt
114
115(** Get source *)
116let source t = t.src
117
118(** Get symbol *)
119let symbol t = t.sym
120
121(** Get type *)
122let type_ t = t.type_
123
124(** Get fix type *)
125let fix t = t.fix
126
127(** Get satellite count *)
128let sat t = t.sat
129
130(** Get horizontal dilution of precision *)
131let hdop t = t.hdop
132
133(** Get vertical dilution of precision *)
134let vdop t = t.vdop
135
136(** Get position dilution of precision *)
137let pdop t = t.pdop
138
139(** Get magnetic variation *)
140let magvar t = t.magvar
141
142(** Get geoid height *)
143let geoidheight t = t.geoidheight
144
145(** Get age of DGPS data *)
146let ageofdgpsdata t = t.ageofdgpsdata
147
148(** Get DGPS ID *)
149let dgpsid t = t.dgpsid
150
151(** Get links *)
152let links t = t.links
153
154(** Get extensions *)
155let extensions t = t.extensions
156
157(** Update elevation *)
158let with_elevation t ele = { t with ele = Some ele }
159
160(** Update time *)
161let with_time t time = { t with time }
162
163(** Update name *)
164let with_name t name = { t with name = Some name }
165
166(** Update comment *)
167let with_comment t cmt = { t with cmt = Some cmt }
168
169(** Update description *)
170let with_description t desc = { t with desc = Some desc }
171
172(** Update source *)
173let with_source t src = { t with src = Some src }
174
175(** Update symbol *)
176let with_symbol t sym = { t with sym = Some sym }
177
178(** Update type *)
179let with_type t type_ = { t with type_ = Some type_ }
180
181(** Update fix *)
182let with_fix t fix = { t with fix }
183
184(** Update satellite count *)
185let with_sat t sat = { t with sat = Some sat }
186
187(** Update HDOP *)
188let with_hdop t hdop = { t with hdop = Some hdop }
189
190(** Update VDOP *)
191let with_vdop t vdop = { t with vdop = Some vdop }
192
193(** Update PDOP *)
194let with_pdop t pdop = { t with pdop = Some pdop }
195
196(** Update magnetic variation *)
197let with_magvar t magvar = { t with magvar = Some magvar }
198
199(** Update geoid height *)
200let with_geoidheight t geoidheight = { t with geoidheight = Some geoidheight }
201
202(** Update age of DGPS data *)
203let with_ageofdgpsdata t ageofdgpsdata = { t with ageofdgpsdata = Some ageofdgpsdata }
204
205(** Update DGPS ID *)
206let with_dgpsid t dgpsid = { t with dgpsid = Some dgpsid }
207
208(** Add link *)
209let add_link t link = { t with links = link :: t.links }
210
211(** Add extensions *)
212let add_extensions t extensions = { t with extensions = extensions @ t.extensions }
213
214(** Compare waypoints *)
215let compare t1 t2 =
216 let lat_cmp = Float.compare
217 (Coordinate.latitude_to_float t1.lat)
218 (Coordinate.latitude_to_float t2.lat) in
219 if lat_cmp <> 0 then lat_cmp
220 else
221 let lon_cmp = Float.compare
222 (Coordinate.longitude_to_float t1.lon)
223 (Coordinate.longitude_to_float t2.lon) in
224 if lon_cmp <> 0 then lon_cmp
225 else
226 let ele_cmp = Option.compare Float.compare t1.ele t2.ele in
227 if ele_cmp <> 0 then ele_cmp
228 else Option.compare Ptime.compare t1.time t2.time
229
230(** Test waypoint equality *)
231let equal t1 t2 = compare t1 t2 = 0
232
233(** Pretty print waypoint *)
234let pp ppf t =
235 let lat, lon = to_floats t in
236 match t.name with
237 | Some name -> Format.fprintf ppf "%s @ (%g, %g)" name lat lon
238 | None -> Format.fprintf ppf "(%g, %g)" lat lon
239
240(** Pretty print fix type *)
241let pp_fix_type ppf = function
242 | None_fix -> Format.fprintf ppf "none"
243 | Fix_2d -> Format.fprintf ppf "2d"
244 | Fix_3d -> Format.fprintf ppf "3d"
245 | Dgps -> Format.fprintf ppf "dgps"
246 | Pps -> Format.fprintf ppf "pps"