Commit refinements from 2015-08-15
[ocaml-x-plane-data.git] / x_plane_data.ml
1 module List = ListLabels
2
3 module Row_speeds = struct
4 type t =
5 { vind_kias : float (* 1 *)
6 ; vind_keas : float (* 2 *)
7 ; vtrue_ktas : float (* 3 *)
8 ; vtrue_ktgs : float (* 4 *)
9 (* 5 *)
10 ; vind_mph : float (* 6 *)
11 ; vtrue_mphas : float (* 7 *)
12 ; vtrue_mphgs : float (* 8 *)
13 }
14 end
15
16 module Row_pitch_roll_heading = struct
17 type t =
18 { pitch_deg : float (* 1 *)
19 ; roll_deg : float (* 2 *)
20 ; hding_true : float (* 3 *)
21 ; hding_mag : float (* 4 *)
22 (* 5 *)
23 (* 6 *)
24 (* 7 *)
25 (* 8 *)
26 }
27 end
28
29 module Row_lat_lon_alt = struct
30 type t =
31 { lat_deg : float (* 1 *)
32 ; lon_deg : float (* 2 *)
33 ; alt_ftmsl : float (* 3 *)
34 ; alt_ftagl : float (* 4 *)
35 ; on_runwy : float (* 5 *)
36 ; alt_ind : float (* 6 *)
37 ; lat_south : float (* 7 *)
38 ; lon_west : float (* 8 *)
39 }
40 end
41
42 module Row : sig
43 type parsing_error =
44 [ `Row_pattern_invalid
45 | `Row_index_byte_out_of_range of int
46 ]
47
48 type index =
49 int
50
51 type values =
52 { column_1 : float
53 ; column_2 : float
54 ; column_3 : float
55 ; column_4 : float
56 ; column_5 : float
57 ; column_6 : float
58 ; column_7 : float
59 ; column_8 : float
60 }
61
62 type t =
63 index * values
64
65 val of_bitstring : Bitstring.t -> t
66
67 val of_string : string -> t
68
69 val show : t -> string
70 end = struct
71 type parsing_error =
72 [ `Row_pattern_invalid
73 | `Row_index_byte_out_of_range of int
74 ]
75
76 type index =
77 int
78
79 type values =
80 { column_1 : float
81 ; column_2 : float
82 ; column_3 : float
83 ; column_4 : float
84 ; column_5 : float
85 ; column_6 : float
86 ; column_7 : float
87 ; column_8 : float
88 }
89
90 type t =
91 index * values
92
93 let of_bitstring bits =
94 bitmatch bits with
95 | { index : 32 : littleendian
96 ; column_1 : 32 : littleendian
97 ; column_2 : 32 : littleendian
98 ; column_3 : 32 : littleendian
99 ; column_4 : 32 : littleendian
100 ; column_5 : 32 : littleendian
101 ; column_6 : 32 : littleendian
102 ; column_7 : 32 : littleendian
103 ; column_8 : 32 : littleendian
104 } ->
105 let index = Int32.to_int index in
106 if index > 0 && index < 133 then
107 let values =
108 { column_1 = Int32.float_of_bits column_1
109 ; column_2 = Int32.float_of_bits column_2
110 ; column_3 = Int32.float_of_bits column_3
111 ; column_4 = Int32.float_of_bits column_4
112 ; column_5 = Int32.float_of_bits column_5
113 ; column_6 = Int32.float_of_bits column_6
114 ; column_7 = Int32.float_of_bits column_7
115 ; column_8 = Int32.float_of_bits column_8
116 }
117 in
118 (index, values)
119 else
120 failwith "Row_index_byte_out_of_range"
121 | {_} ->
122 failwith "Row_pattern_invalid"
123
124 let of_string s =
125 of_bitstring (Bitstring.bitstring_of_string s)
126
127 let show (index, values) =
128 let
129 { column_1
130 ; column_2
131 ; column_3
132 ; column_4
133 ; column_5
134 ; column_6
135 ; column_7
136 ; column_8
137 } = values
138 in
139 Printf.sprintf
140 "[ %3d ] [ %11f | %11f | %11f | %11f | %11f | %11f | %11f | %11f ]"
141 index
142 column_1
143 column_2
144 column_3
145 column_4
146 column_5
147 column_6
148 column_7
149 column_8
150 end
151
152 module Data : sig
153 type t =
154 Row.t list
155
156 val of_string : string -> t
157 end = struct
158 type t =
159 Row.t list
160
161 type parsing_error =
162 [ `Packet_unrecognized
163 | `Packet_index_byte_unsupported of string
164 | Row.parsing_error
165 ]
166
167 let split rows =
168 let rec split rows =
169 bitmatch rows with
170 | { row : 36 * 8 : bitstring
171 ; rows : -1 : bitstring
172 } ->
173 row :: split rows
174 | {_ : 0 : bitstring} ->
175 []
176 in
177 if Bitstring.bitstring_length rows mod 36 = 0 then
178 split rows
179 else
180 failwith "Packet_length_invalid"
181
182 let of_bitstring bits =
183 bitmatch bits with
184 | { "DATA" : 4 * 8 : string
185 ; "@" : 1 * 8 : string
186 ; rows : -1 : bitstring
187 } ->
188 let rows = split rows in
189 List.map rows ~f:Row.of_bitstring
190 | { "DATA" : 4 * 8 : string
191 ; _ : 1 * 8 : string
192 ; _ : -1 : bitstring
193 } ->
194 failwith "Packet_index_byte_unsupported"
195 | {_} ->
196 failwith "Packet_unrecognized"
197
198 let of_string s =
199 of_bitstring (Bitstring.bitstring_of_string s)
200 end
201
202 let sample_packets_base64 =
203 [ "REFUQUADAAAAbcpGQLt81EBfZNlATnUoNwDAecSow2RAnCv6QLrbQTcRAAAA3i8VQFL3ZT6dPfFCx4IFQwDAecQAwHnEAMB5xADAecQUAAAA1ZciQg6ik8JGBv9AdDxoPgAAgD9G/o3CAAAgQgAAlsI="
204 ; "REFUQUADAAAAzqjrQknD60JR+O5C7ZfuQgDAecSTmAdDOoAJQyJJCUMRAAAAXRhvv591jsFLRJhDAgWfQwDAecQAwHnEAMB5xADAecQUAAAAjaMiQveok8LRbtxC6EfIQgAAAAAj2cpCAAAgQgAAlsI="
205 ; "REFUQUADAAAAzqjrQr3J60I1/+5CHLruQgDAecSTmAdDMYQJQ8JdCUMRAAAAuRT1viXUasG1IphDaeOeQwDAecQAwHnEAMB5xADAecQUAAAAoqMiQg6pk8LnP91CnEPJQgAAgD8Xo8tCAAAgQgAAlsI="
206 ; "REFUQUADAAAAzqngQlS14EJH0uNC1j3jQgDAecTaRAFDChYDQ0XjAkMRAAAAyAVbwD2F40D9o5hDw2OfQwDAecQAwHnEAMB5xADAecQUAAAAabAiQmGzk8KHqPtCUffQQgAAgD+gHOxCAAAgQgAAlsI="
207 ; "REFUQUADAAAAztfrQgj060IIWO9C3ZvuQgDAecSeswdDTLcJQx9SCUMRAAAAOHQSv6Pb98B47plDj66gQwDAecQAwHnEAMB5xADAecQUAAAAna0iQmSwk8L9HyFDSWYPQwAAgD993xhDAAAgQgAAlsI="
208 ; "REFUQUADAAAAzv7OQngMz0JiytFCPCPTQgDAecS7NO5CNGzxQj798kIRAAAAYSvYv6xFF0HmNZND+vSZQwDAecQAwHnEAMB5xADAecQUAAAAubUiQqm5k8KdoKhC7QVrQgAAgD8gY5lCAAAgQgAAlsI="
209 ; "REFUQUADAAAAzwhhQveKYUKRQ2RCrX5iQgDAecSEe4FCOleDQqlSgkIRAAAA52WSP04IoL8625ZDu56dQwDAecQAwHnEAMB5xADAecQUAAAAKIQiQlKMk8Lv3/pA6leoPgAAgD/0ZwrAAAAgQgAAlsI="
210 ; "REFUQUADAAAAzxOEQlE+hELg1oVCLBOFQgDAecTw/ZdCAwWaQusjmUIRAAAAIbAwv9Vvm8CwrJZDIXCdQwDAecQAwHnEAMB5xADAecQUAAAAqYQiQuOMk8IABAFBf1gDPwAAgD9YJve/AAAgQgAAlsI="
211 ; "REFUQUADAAAAzybdQm4t3UJ7POBC6pvfQgDAecQpf/5C8wUBQ8m7AEMRAAAAFUxfP6uiNb6HV5lDPxegQwDAecQAwHnEAMB5xADAecQUAAAA+LAiQumzk8JhAflCuZfOQgAAgD9azehCAAAgQgAAlsI="
212 ; "REFUQUADAAAAzzXpQXNs6kEZau1BalvYQQDAecTPLwZCGJsIQngD+UERAAAABIOrP1nfGr0X7qpDY6yxQwDAecQAwHnEAMB5xADAecQUAAAAlbwiQgPBk8JTQExC0iGDPgAAgD+EOi9CAAAgQgAAlsI="
213 ; "REFUQUADAAAAzzyRQNGvwUDwBcRA3GiMQADAecTpIqdAWZThQLaUoUARAAAAoQokQCjkLr5IGZZD6NycQwDAecQAwHnEAMB5xADAecQUAAAAEoMiQimLk8Jy4fZAaipjPgAAgD82RhLAAAAgQgAAlsI="
214 ]
215
216 let main () =
217 List.iter sample_packets_base64 ~f:(fun sample_packet_base64 ->
218 let packet = B64.decode sample_packet_base64 in
219 let data_indexed = Data.of_string packet in
220 List.iter data_indexed ~f:(fun row -> print_endline (Row.show row))
221 )
222
223 let () = main ()
This page took 0.103901 seconds and 5 git commands to generate.