package mlgpx

  1. Overview
  2. Docs

Source file track.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
(** Track types and operations *)

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

(** Track segment *)
type segment = {
  trkpts : point list;
  extensions : Extension.t list;
}

(** Main track 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;
  trksegs : segment list;
}

(** {2 Track Segment Operations} *)

module Segment = struct
  type t = segment

  (** Create empty segment *)
  let empty = { trkpts = []; extensions = [] }

  (** Create segment with points *)
  let make points = { trkpts = points; extensions = [] }

  (** Create segment from coordinates *)
  let make_from_coords coords =
    let make_trkpt (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 trkpts = List.map make_trkpt coords in
    { trkpts; extensions = [] }

  (** Get points *)
  let points t = t.trkpts

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

  (** Get extensions *)
  let extensions (seg : segment) = seg.extensions

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

  (** Add points *)
  let add_points t points = { t with trkpts = t.trkpts @ points }

  (** Extract coordinates *)
  let to_coords t = List.map Waypoint.to_floats t.trkpts

  (** Calculate segment distance *)
  let distance t = Route.total_distance { Route.empty with rtepts = t.trkpts }

  (** Check if empty *)
  let is_empty t = List.length t.trkpts = 0

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

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

  (** Compare segments *)
  let compare t1 t2 = List.compare Waypoint.compare t1.trkpts t2.trkpts

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

  (** Pretty print segment *)
  let pp ppf t = Format.fprintf ppf "segment (%d points)" (point_count t)
end

(** {2 Track Operations} *)

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

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

(** Create track from coordinate list (single segment) *)
let make_from_coords ~name coords =
  let segment = Segment.make_from_coords coords in
  { empty with name = Some name; trksegs = [segment] }

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

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

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

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

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

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

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

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

(** Get track segments *)
let segments t = t.trksegs

(** Get segment count *)
let segment_count t = List.length t.trksegs

(** Get total point count across all segments *)
let point_count t = 
  List.fold_left (fun acc seg -> acc + Segment.point_count seg) 0 t.trksegs


(** Clear all segments *)
let clear_segments t = { t with trksegs = [] }

(** Extract all coordinates from track *)
let to_coords t =
  List.fold_left (fun acc seg ->
    List.fold_left (fun acc trkpt ->
      Waypoint.to_floats trkpt :: acc
    ) acc seg.trkpts
  ) [] t.trksegs
  |> List.rev

(** Calculate total track distance across all segments *)
let total_distance t =
  List.fold_left (fun acc seg -> acc +. Segment.distance seg) 0.0 t.trksegs

(** Check if track is empty *)
let is_empty t = List.length t.trksegs = 0

(** Get all points from all segments *)
let all_points t =
  List.fold_left (fun acc seg -> acc @ seg.trkpts) [] t.trksegs

(** Get first point from first segment *)
let first_point t =
  match t.trksegs with
  | [] -> None
  | seg :: _ -> Segment.first_point seg

(** Get last point from last segment *)
let last_point t =
  match List.rev t.trksegs with
  | [] -> None
  | seg :: _ -> Segment.last_point seg

(** Compare tracks *)
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 Segment.compare t1.trksegs t2.trksegs

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

(** {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 segment *)
let add_segment t trkseg = { t with trksegs = t.trksegs @ [trkseg] }

(** 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 }

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

Innovation. Community. Security.