Commit refinements from 2015-08-15

[ocaml-x-plane-data.git] / x_plane_data.ml

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 =
    { 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
      ; 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
      } ->
        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
      column_1
      column_2
      column_3
      column_4
      column_5
      column_6
      column_7
      column_8
end

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 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 () =
  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 ()