Commit refinements from 2015-08-15

diff --git a/x_plane_data.ml b/x_plane_data.ml
index fd40cf1..83ddcaa 100644 (file)
--- a/x_plane_data.ml
+++ b/x_plane_data.ml
@@ -1,66 +1,223 @@
-module Datum = struct
+module List = ListLabels
+
+module Row_speeds = struct
+  type t =
+    { vind_kias   : float (* 1 *)
+    ; vind_keas   : float (* 2 *)
+    ; vtrue_ktas  : float (* 3 *)
+    ; vtrue_ktgs  : float (* 4 *)
+                          (* 5 *)
+    ; vind_mph    : float (* 6 *)
+    ; vtrue_mphas : float (* 7 *)
+    ; vtrue_mphgs : float (* 8 *)
+    }
+end
+
+module Row_pitch_roll_heading = struct
   type t =
-    { index : int
-    ;    v1 : float
-    ;    v2 : float
-    ;    v3 : float
-    ;    v4 : float
-    ;    v5 : float
-    ;    v6 : float
-    ;    v7 : float
-    ;    v8 : float
+    { pitch_deg  : float (* 1 *)
+    ; roll_deg   : float (* 2 *)
+    ; hding_true : float (* 3 *)
+    ; hding_mag  : float (* 4 *)
+                         (* 5 *)
+                         (* 6 *)
+                         (* 7 *)
+                         (* 8 *)
+    }
+end
+
+module Row_lat_lon_alt = struct
+  type t =
+    { lat_deg   : float (* 1 *)
+    ; lon_deg   : float (* 2 *)
+    ; alt_ftmsl : float (* 3 *)
+    ; alt_ftagl : float (* 4 *)
+    ; on_runwy  : float (* 5 *)
+    ; alt_ind   : float (* 6 *)
+    ; lat_south : float (* 7 *)
+    ; lon_west  : float (* 8 *)
+    }
+end
+
+module Row : sig
+  type parsing_error =
+    [ `Row_pattern_invalid
+    | `Row_index_byte_out_of_range of int
+    ]
+
+  type index =
+    int
+
+  type values =
+    { column_1 : float
+    ; column_2 : float
+    ; column_3 : float
+    ; column_4 : float
+    ; column_5 : float
+    ; column_6 : float
+    ; column_7 : float
+    ; column_8 : float
     }
 
+  type t =
+    index * values
+
+  val of_bitstring : Bitstring.t -> t
+
+  val of_string : string -> t
+
+  val show : t -> string
+end = struct
+  type parsing_error =
+    [ `Row_pattern_invalid
+    | `Row_index_byte_out_of_range of int
+    ]
+
+  type index =
+    int
+
+  type values =
+    { column_1 : float
+    ; column_2 : float
+    ; column_3 : float
+    ; column_4 : float
+    ; column_5 : float
+    ; column_6 : float
+    ; column_7 : float
+    ; column_8 : float
+    }
+
+  type t =
+    index * values
+
   let of_bitstring bits =
     bitmatch bits with
-    | { index : 32 : littleendian
-      ;    v1 : 32 : littleendian
-      ;    v2 : 32 : littleendian
-      ;    v3 : 32 : littleendian
-      ;    v4 : 32 : littleendian
-      ;    v5 : 32 : littleendian
-      ;    v6 : 32 : littleendian
-      ;    v7 : 32 : littleendian
-      ;    v8 : 32 : littleendian
+    | { index    : 32 : littleendian
+      ; column_1 : 32 : littleendian
+      ; column_2 : 32 : littleendian
+      ; column_3 : 32 : littleendian
+      ; column_4 : 32 : littleendian
+      ; column_5 : 32 : littleendian
+      ; column_6 : 32 : littleendian
+      ; column_7 : 32 : littleendian
+      ; column_8 : 32 : littleendian
       } ->
-        { index = Int32.to_int        index
-        ;    v1 = Int32.float_of_bits v1
-        ;    v2 = Int32.float_of_bits v2
-        ;    v3 = Int32.float_of_bits v3
-        ;    v4 = Int32.float_of_bits v4
-        ;    v5 = Int32.float_of_bits v5
-        ;    v6 = Int32.float_of_bits v6
-        ;    v7 = Int32.float_of_bits v7
-        ;    v8 = Int32.float_of_bits v8
-        }
-
-  let show {index; v1; v2; v3; v4; v5; v6; v7; v8} =
+        let index = Int32.to_int index in
+        if index > 0 && index < 133 then
+          let values =
+            { column_1 = Int32.float_of_bits column_1
+            ; column_2 = Int32.float_of_bits column_2
+            ; column_3 = Int32.float_of_bits column_3
+            ; column_4 = Int32.float_of_bits column_4
+            ; column_5 = Int32.float_of_bits column_5
+            ; column_6 = Int32.float_of_bits column_6
+            ; column_7 = Int32.float_of_bits column_7
+            ; column_8 = Int32.float_of_bits column_8
+            }
+          in
+          (index, values)
+        else
+          failwith "Row_index_byte_out_of_range"
+    | {_} ->
+        failwith "Row_pattern_invalid"
+
+  let of_string s =
+    of_bitstring (Bitstring.bitstring_of_string s)
+
+  let show (index, values) =
+    let
+      { column_1
+      ; column_2
+      ; column_3
+      ; column_4
+      ; column_5
+      ; column_6
+      ; column_7
+      ; column_8
+      } = values
+    in
     Printf.sprintf
-      "| %3d | %11f | %11f | %11f | %11f | %11f | %11f | %11f | %11f |"
-      index   v1   v2   v3   v4   v5   v6   v7   v8
+      "[ %3d ] [ %11f | %11f | %11f | %11f | %11f | %11f | %11f | %11f ]"
+      index
+      column_1
+      column_2
+      column_3
+      column_4
+      column_5
+      column_6
+      column_7
+      column_8
 end
 
-let sample_packet_base64 =
-  "REFUQUADAAAAbcpGQLt81EBfZNlATnUoNwDAecSow2RAnCv6QLrbQTcRAAAA3i8VQFL3ZT6dPfFCx4IFQwDAecQAwHnEAMB5xADAecQUAAAA1ZciQg6ik8JGBv9AdDxoPgAAgD9G/o3CAAAgQgAAlsI="
+module Data : sig
+  type t =
+    Row.t list
+
+  val of_string : string -> t
+end = struct
+  type t =
+    Row.t list
+
+  type parsing_error =
+    [ `Packet_unrecognized
+    | `Packet_index_byte_unsupported of string
+    | Row.parsing_error
+    ]
 
-let rec split blocks =
-  bitmatch blocks with
-  | { block  : 36 * 8 : bitstring
-    ; blocks : -1     : bitstring
-    } ->
-      block :: (split blocks)
-  | {_ : 0 : bitstring} ->
-      []
+  let split rows =
+    let rec split rows =
+      bitmatch rows with
+      | { row  : 36 * 8 : bitstring
+        ; rows : -1     : bitstring
+        } ->
+          row :: split rows
+      | {_ : 0 : bitstring} ->
+          []
+    in
+    if Bitstring.bitstring_length rows mod 36 = 0 then
+      split rows
+    else
+      failwith "Packet_length_invalid"
+
+  let of_bitstring bits =
+    bitmatch bits with
+    | { "DATA" : 4 * 8 : string
+      ; "@"    : 1 * 8 : string
+      ; rows   : -1    : bitstring
+      } ->
+        let rows = split rows in
+        List.map rows ~f:Row.of_bitstring
+    | { "DATA" : 4 * 8 : string
+      ; _      : 1 * 8 : string
+      ; _      : -1    : bitstring
+      } ->
+        failwith "Packet_index_byte_unsupported"
+    | {_} ->
+        failwith "Packet_unrecognized"
+
+  let of_string s =
+    of_bitstring (Bitstring.bitstring_of_string s)
+end
+
+let sample_packets_base64 =
+  [ "REFUQUADAAAAbcpGQLt81EBfZNlATnUoNwDAecSow2RAnCv6QLrbQTcRAAAA3i8VQFL3ZT6dPfFCx4IFQwDAecQAwHnEAMB5xADAecQUAAAA1ZciQg6ik8JGBv9AdDxoPgAAgD9G/o3CAAAgQgAAlsI="
+  ; "REFUQUADAAAAzqjrQknD60JR+O5C7ZfuQgDAecSTmAdDOoAJQyJJCUMRAAAAXRhvv591jsFLRJhDAgWfQwDAecQAwHnEAMB5xADAecQUAAAAjaMiQveok8LRbtxC6EfIQgAAAAAj2cpCAAAgQgAAlsI="
+  ; "REFUQUADAAAAzqjrQr3J60I1/+5CHLruQgDAecSTmAdDMYQJQ8JdCUMRAAAAuRT1viXUasG1IphDaeOeQwDAecQAwHnEAMB5xADAecQUAAAAoqMiQg6pk8LnP91CnEPJQgAAgD8Xo8tCAAAgQgAAlsI="
+  ; "REFUQUADAAAAzqngQlS14EJH0uNC1j3jQgDAecTaRAFDChYDQ0XjAkMRAAAAyAVbwD2F40D9o5hDw2OfQwDAecQAwHnEAMB5xADAecQUAAAAabAiQmGzk8KHqPtCUffQQgAAgD+gHOxCAAAgQgAAlsI="
+  ; "REFUQUADAAAAztfrQgj060IIWO9C3ZvuQgDAecSeswdDTLcJQx9SCUMRAAAAOHQSv6Pb98B47plDj66gQwDAecQAwHnEAMB5xADAecQUAAAAna0iQmSwk8L9HyFDSWYPQwAAgD993xhDAAAgQgAAlsI="
+  ; "REFUQUADAAAAzv7OQngMz0JiytFCPCPTQgDAecS7NO5CNGzxQj798kIRAAAAYSvYv6xFF0HmNZND+vSZQwDAecQAwHnEAMB5xADAecQUAAAAubUiQqm5k8KdoKhC7QVrQgAAgD8gY5lCAAAgQgAAlsI="
+  ; "REFUQUADAAAAzwhhQveKYUKRQ2RCrX5iQgDAecSEe4FCOleDQqlSgkIRAAAA52WSP04IoL8625ZDu56dQwDAecQAwHnEAMB5xADAecQUAAAAKIQiQlKMk8Lv3/pA6leoPgAAgD/0ZwrAAAAgQgAAlsI="
+  ; "REFUQUADAAAAzxOEQlE+hELg1oVCLBOFQgDAecTw/ZdCAwWaQusjmUIRAAAAIbAwv9Vvm8CwrJZDIXCdQwDAecQAwHnEAMB5xADAecQUAAAAqYQiQuOMk8IABAFBf1gDPwAAgD9YJve/AAAgQgAAlsI="
+  ; "REFUQUADAAAAzybdQm4t3UJ7POBC6pvfQgDAecQpf/5C8wUBQ8m7AEMRAAAAFUxfP6uiNb6HV5lDPxegQwDAecQAwHnEAMB5xADAecQUAAAA+LAiQumzk8JhAflCuZfOQgAAgD9azehCAAAgQgAAlsI="
+  ; "REFUQUADAAAAzzXpQXNs6kEZau1BalvYQQDAecTPLwZCGJsIQngD+UERAAAABIOrP1nfGr0X7qpDY6yxQwDAecQAwHnEAMB5xADAecQUAAAAlbwiQgPBk8JTQExC0iGDPgAAgD+EOi9CAAAgQgAAlsI="
+  ; "REFUQUADAAAAzzyRQNGvwUDwBcRA3GiMQADAecTpIqdAWZThQLaUoUARAAAAoQokQCjkLr5IGZZD6NycQwDAecQAwHnEAMB5xADAecQUAAAAEoMiQimLk8Jy4fZAaipjPgAAgD82RhLAAAAgQgAAlsI="
+  ]
 
 let main () =
-  let packet = B64.decode sample_packet_base64 in
-  let packet = Bitstring.bitstring_of_string packet in
-  bitmatch packet with
-  | { "DATA" : 4 * 8 : string
-    ; "@"    : 1 * 8 : string
-    ; blocks : -1    : bitstring
-    } ->
-      let blocks = split blocks in
-      List.iter (fun b -> print_endline (Datum.show (Datum.of_bitstring b))) blocks
-
-let () = main ()
\ No newline at end of file
+  List.iter sample_packets_base64 ~f:(fun sample_packet_base64 ->
+    let packet = B64.decode sample_packet_base64 in
+    let data_indexed = Data.of_string packet in
+    List.iter data_indexed ~f:(fun row -> print_endline (Row.show row))
+  )
+
+let () = main ()