GPS Exchange Format library/CLI in OCaml
anil.recoil.org
1(** Track types and operations *)
2
3(** Track point is an alias for waypoint *)
4type point = Waypoint.t
5
6(** Track segment *)
7type segment = {
8 trkpts : point list;
9 extensions : Extension.t list;
10}
11
12(** Main track type *)
13type t = {
14 name : string option;
15 cmt : string option;
16 desc : string option;
17 src : string option;
18 links : Link.t list;
19 number : int option;
20 type_ : string option;
21 extensions : Extension.t list;
22 trksegs : segment list;
23}
24
25(** {2 Track Segment Operations} *)
26
27module Segment = struct
28 type t = segment
29
30 (** Create empty segment *)
31 let empty = { trkpts = []; extensions = [] }
32
33 (** Create segment with points *)
34 let make points = { trkpts = points; extensions = [] }
35
36 (** Create segment from coordinates *)
37 let make_from_coords coords =
38 let make_trkpt (lat_f, lon_f) =
39 match Waypoint.make_from_floats ~lat:lat_f ~lon:lon_f () with
40 | Ok wpt -> wpt
41 | Error e -> invalid_arg e
42 in
43 let trkpts = List.map make_trkpt coords in
44 { trkpts; extensions = [] }
45
46 (** Get points *)
47 let points t = t.trkpts
48
49 (** Get point count *)
50 let point_count t = List.length t.trkpts
51
52 (** Get extensions *)
53 let extensions (seg : segment) = seg.extensions
54
55 (** Add point *)
56 let add_point t point = { t with trkpts = t.trkpts @ [point] }
57
58 (** Add points *)
59 let add_points t points = { t with trkpts = t.trkpts @ points }
60
61 (** Extract coordinates *)
62 let to_coords t = List.map Waypoint.to_floats t.trkpts
63
64 (** Calculate segment distance *)
65 let distance t = Route.total_distance { Route.empty with rtepts = t.trkpts }
66
67 (** Check if empty *)
68 let is_empty t = List.length t.trkpts = 0
69
70 (** First point *)
71 let first_point t =
72 match t.trkpts with
73 | [] -> None
74 | p :: _ -> Some p
75
76 (** Last point *)
77 let last_point t =
78 match List.rev t.trkpts with
79 | [] -> None
80 | p :: _ -> Some p
81
82 (** Compare segments *)
83 let compare t1 t2 = List.compare Waypoint.compare t1.trkpts t2.trkpts
84
85 (** Test segment equality *)
86 let equal t1 t2 = compare t1 t2 = 0
87
88 (** Pretty print segment *)
89 let pp ppf t = Format.fprintf ppf "segment (%d points)" (point_count t)
90end
91
92(** {2 Track Operations} *)
93
94(** Create empty track *)
95let empty = {
96 name = None; cmt = None; desc = None; src = None;
97 links = []; number = None; type_ = None; extensions = [];
98 trksegs = [];
99}
100
101(** Create track with name *)
102let make ~name = { empty with name = Some name }
103
104(** Create track from coordinate list (single segment) *)
105let make_from_coords ~name coords =
106 let segment = Segment.make_from_coords coords in
107 { empty with name = Some name; trksegs = [segment] }
108
109(** Get track name *)
110let name t = t.name
111
112(** Get track description *)
113let description t = t.desc
114
115(** Get track comment *)
116let comment t = t.cmt
117
118(** Get track source *)
119let source t = t.src
120
121(** Get track links *)
122let links t = t.links
123
124(** Get track number *)
125let number t = t.number
126
127(** Get track type *)
128let type_ t = t.type_
129
130(** Get track extensions *)
131let extensions t = t.extensions
132
133(** Get track segments *)
134let segments t = t.trksegs
135
136(** Get segment count *)
137let segment_count t = List.length t.trksegs
138
139(** Get total point count across all segments *)
140let point_count t =
141 List.fold_left (fun acc seg -> acc + Segment.point_count seg) 0 t.trksegs
142
143
144(** Clear all segments *)
145let clear_segments t = { t with trksegs = [] }
146
147(** Extract all coordinates from track *)
148let to_coords t =
149 List.fold_left (fun acc seg ->
150 List.fold_left (fun acc trkpt ->
151 Waypoint.to_floats trkpt :: acc
152 ) acc seg.trkpts
153 ) [] t.trksegs
154 |> List.rev
155
156(** Calculate total track distance across all segments *)
157let total_distance t =
158 List.fold_left (fun acc seg -> acc +. Segment.distance seg) 0.0 t.trksegs
159
160(** Check if track is empty *)
161let is_empty t = List.length t.trksegs = 0
162
163(** Get all points from all segments *)
164let all_points t =
165 List.fold_left (fun acc seg -> acc @ seg.trkpts) [] t.trksegs
166
167(** Get first point from first segment *)
168let first_point t =
169 match t.trksegs with
170 | [] -> None
171 | seg :: _ -> Segment.first_point seg
172
173(** Get last point from last segment *)
174let last_point t =
175 match List.rev t.trksegs with
176 | [] -> None
177 | seg :: _ -> Segment.last_point seg
178
179(** Compare tracks *)
180let compare t1 t2 =
181 let name_cmp = Option.compare String.compare t1.name t2.name in
182 if name_cmp <> 0 then name_cmp
183 else
184 let desc_cmp = Option.compare String.compare t1.desc t2.desc in
185 if desc_cmp <> 0 then desc_cmp
186 else List.compare Segment.compare t1.trksegs t2.trksegs
187
188(** Test track equality *)
189let equal t1 t2 = compare t1 t2 = 0
190
191(** {2 Functional Operations} *)
192
193(** Update name *)
194let with_name t name = { t with name = Some name }
195
196(** Update comment *)
197let with_comment t cmt = { t with cmt = Some cmt }
198
199(** Update description *)
200let with_description t desc = { t with desc = Some desc }
201
202(** Update source *)
203let with_source t src = { t with src = Some src }
204
205(** Update number *)
206let with_number t number = { t with number = Some number }
207
208(** Update type *)
209let with_type t type_ = { t with type_ = Some type_ }
210
211(** Add segment *)
212let add_segment t trkseg = { t with trksegs = t.trksegs @ [trkseg] }
213
214(** Add link *)
215let add_link t link = { t with links = t.links @ [link] }
216
217(** Add extensions *)
218let add_extensions t extensions = { t with extensions = t.extensions @ extensions }
219
220(** Pretty print track *)
221let pp ppf t =
222 match t.name with
223 | Some name -> Format.fprintf ppf "\"%s\" (%d segments, %d points)"
224 name (segment_count t) (point_count t)
225 | None -> Format.fprintf ppf "(unnamed track, %d segments, %d points)"
226 (segment_count t) (point_count t)