diff --git a/conf/telemetry/aerocomm.xml b/conf/telemetry/aerocomm.xml
index f0791e1bed2..c836810d7cc 100644
--- a/conf/telemetry/aerocomm.xml
+++ b/conf/telemetry/aerocomm.xml
@@ -6,7 +6,7 @@
-
+
diff --git a/conf/telemetry/booz_minimal.xml b/conf/telemetry/booz_minimal.xml
index c4675301bec..281730aa574 100644
--- a/conf/telemetry/booz_minimal.xml
+++ b/conf/telemetry/booz_minimal.xml
@@ -12,7 +12,7 @@
-
+
@@ -22,7 +22,7 @@
-
+
diff --git a/conf/telemetry/default.xml b/conf/telemetry/default.xml
index 733c758e682..89fee5251a9 100644
--- a/conf/telemetry/default.xml
+++ b/conf/telemetry/default.xml
@@ -10,7 +10,7 @@
-
+
@@ -34,7 +34,7 @@
-
+
diff --git a/conf/telemetry/default_fixedwing_imu.xml b/conf/telemetry/default_fixedwing_imu.xml
index 6f6c00e73be..f7f832e34d8 100644
--- a/conf/telemetry/default_fixedwing_imu.xml
+++ b/conf/telemetry/default_fixedwing_imu.xml
@@ -10,7 +10,7 @@
-
+
@@ -36,7 +36,7 @@
-
+
diff --git a/conf/telemetry/default_fixedwing_imu_9k6.xml b/conf/telemetry/default_fixedwing_imu_9k6.xml
index b5f0eff3c4b..e97b9046a99 100644
--- a/conf/telemetry/default_fixedwing_imu_9k6.xml
+++ b/conf/telemetry/default_fixedwing_imu_9k6.xml
@@ -10,7 +10,7 @@
-
+
@@ -36,7 +36,7 @@
-
+
diff --git a/conf/telemetry/fw_h_ctl_a.xml b/conf/telemetry/fw_h_ctl_a.xml
index 1f306588b5b..d9bf211906c 100644
--- a/conf/telemetry/fw_h_ctl_a.xml
+++ b/conf/telemetry/fw_h_ctl_a.xml
@@ -8,7 +8,7 @@
-
+
diff --git a/conf/telemetry/hitl.xml b/conf/telemetry/hitl.xml
index 36f504f426e..034ed1b6532 100644
--- a/conf/telemetry/hitl.xml
+++ b/conf/telemetry/hitl.xml
@@ -6,7 +6,7 @@
-
+
diff --git a/conf/telemetry/iridium.xml b/conf/telemetry/iridium.xml
index 27042bc9feb..6ca164367e4 100644
--- a/conf/telemetry/iridium.xml
+++ b/conf/telemetry/iridium.xml
@@ -9,7 +9,7 @@
-
+
diff --git a/conf/telemetry/minimal.xml b/conf/telemetry/minimal.xml
index 420735b8767..3789235f917 100644
--- a/conf/telemetry/minimal.xml
+++ b/conf/telemetry/minimal.xml
@@ -6,7 +6,7 @@
-
+
diff --git a/conf/telemetry/osam_imu.xml b/conf/telemetry/osam_imu.xml
index 95e6b74cf26..22efef2abca 100644
--- a/conf/telemetry/osam_imu.xml
+++ b/conf/telemetry/osam_imu.xml
@@ -6,7 +6,7 @@
-
+
diff --git a/conf/telemetry/telemetry_booz2.xml b/conf/telemetry/telemetry_booz2.xml
index ab868c2c5b2..9851f5ff511 100644
--- a/conf/telemetry/telemetry_booz2.xml
+++ b/conf/telemetry/telemetry_booz2.xml
@@ -12,7 +12,7 @@
-
+
diff --git a/conf/telemetry/telemetry_jtm.xml b/conf/telemetry/telemetry_jtm.xml
index 3767ec78428..8544edf662c 100644
--- a/conf/telemetry/telemetry_jtm.xml
+++ b/conf/telemetry/telemetry_jtm.xml
@@ -12,7 +12,7 @@
-
+
diff --git a/conf/telemetry/tl.xml b/conf/telemetry/tl.xml
index 30272b19cc3..f82332f4c92 100644
--- a/conf/telemetry/tl.xml
+++ b/conf/telemetry/tl.xml
@@ -15,7 +15,7 @@
-
+
diff --git a/conf/telemetry/ugv.xml b/conf/telemetry/ugv.xml
index fea3f094e91..bb153041b8b 100644
--- a/conf/telemetry/ugv.xml
+++ b/conf/telemetry/ugv.xml
@@ -4,7 +4,7 @@
-
+
diff --git a/conf/telemetry/xbee868.xml b/conf/telemetry/xbee868.xml
index e4d4b491866..95e73ffaa28 100755
--- a/conf/telemetry/xbee868.xml
+++ b/conf/telemetry/xbee868.xml
@@ -9,7 +9,7 @@
-
+
diff --git a/sw/airborne/firmwares/fixedwing/ap_downlink.h b/sw/airborne/firmwares/fixedwing/ap_downlink.h
index b47a1ff05a1..339bd3f1a20 100644
--- a/sw/airborne/firmwares/fixedwing/ap_downlink.h
+++ b/sw/airborne/firmwares/fixedwing/ap_downlink.h
@@ -117,7 +117,7 @@ extern uint8_t telemetry_mode_Ap_DefaultChannel;
}
-#define PERIODIC_SEND_WP_MOVED_UTM(_trans, _dev) { \
+#define PERIODIC_SEND_WP_MOVED(_trans, _dev) { \
static uint8_t i; \
i++; if (i >= nb_waypoint) i = 0; \
DownlinkSendWp(_trans, _dev, i); \
diff --git a/sw/airborne/firmwares/rotorcraft/telemetry.h b/sw/airborne/firmwares/rotorcraft/telemetry.h
index ef56a6b8925..e25d84f3dd8 100644
--- a/sw/airborne/firmwares/rotorcraft/telemetry.h
+++ b/sw/airborne/firmwares/rotorcraft/telemetry.h
@@ -703,7 +703,7 @@ extern uint8_t telemetry_mode_Main_DefaultChannel;
} \
}
-#define PERIODIC_SEND_WP_MOVED_UTM(_trans, _dev) { \
+#define PERIODIC_SEND_WP_MOVED(_trans, _dev) { \
static uint8_t i; \
i++; if (i >= nb_waypoint) i = 0; \
DOWNLINK_SEND_WP_MOVED_ENU(_trans, _dev, \
diff --git a/sw/ground_segment/tmtc/ivy2udp.ml b/sw/ground_segment/tmtc/ivy2udp.ml
index f1940282a82..9305c020dc4 100644
--- a/sw/ground_segment/tmtc/ivy2udp.ml
+++ b/sw/ground_segment/tmtc/ivy2udp.ml
@@ -61,7 +61,7 @@ let () =
let get_ivy_message = fun _ args ->
try
let (msg_id, vs) = Tm_Pprz.values_of_string args.(0) in
- let payload = Tm_Pprz.payload_of_values (int_of_string !id) (Pprz.class_id_of_msg_args args.(0)) msg_id vs in
+ let payload = Tm_Pprz.payload_of_values (int_of_string !id) ~class_id:(Pprz.class_id_of_msg_args args.(0)) msg_id vs in
let buf = Pprz.Transport.packet payload in
let n = String.length buf in
let n' = Unix.sendto socket buf 0 n [] sockaddr in
@@ -87,7 +87,7 @@ let () =
let use_dl_message = fun payload ->
Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload));
let (packet_seq, ac_id, class_id, msg_id, values) = Dl_Pprz.values_of_payload payload in
- let msg = Dl_Pprz.message_of_id class_id msg_id in
+ let msg = Dl_Pprz.message_of_id ~class_id:class_id msg_id in
Dl_Pprz.message_send "ground_dl" msg.Pprz.name values in
assert (PprzTransport.parse use_dl_message b = n)
diff --git a/sw/ground_segment/tmtc/ivy_tcp_aircraft.ml b/sw/ground_segment/tmtc/ivy_tcp_aircraft.ml
index 415219cca13..f857777f0cd 100644
--- a/sw/ground_segment/tmtc/ivy_tcp_aircraft.ml
+++ b/sw/ground_segment/tmtc/ivy_tcp_aircraft.ml
@@ -32,7 +32,7 @@ let () =
let get_ivy_message = fun _ args ->
try
let (msg_id, vs) = Tm_Pprz.values_of_string args.(0) in
- let payload = Tm_Pprz.payload_of_values (int_of_string !id) (Pprz.class_id_of_msg_args args.(0)) msg_id vs in
+ let payload = Tm_Pprz.payload_of_values (int_of_string !id) ~class_id:(Pprz.class_id_of_msg_args args.(0)) msg_id vs in
let buf = Pprz.Transport.packet payload in
fprintf o "%s%!" buf
with _ -> () in
@@ -51,7 +51,7 @@ let () =
let use_dl_message = fun payload ->
Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload));
let (packet_seq, ac_id, class_id, msg_id, values) = Dl_Pprz.values_of_payload payload in
- let msg = Dl_Pprz.message_of_id class_id msg_id in
+ let msg = Dl_Pprz.message_of_id ~class_id:class_id msg_id in
Dl_Pprz.message_send "ground_dl" msg.Pprz.name values in
assert (PprzTransport.parse use_dl_message b = n)
diff --git a/sw/ground_segment/tmtc/ivy_tcp_controller.ml b/sw/ground_segment/tmtc/ivy_tcp_controller.ml
index 793c572fd7d..d38c3da6cd2 100644
--- a/sw/ground_segment/tmtc/ivy_tcp_controller.ml
+++ b/sw/ground_segment/tmtc/ivy_tcp_controller.ml
@@ -39,7 +39,7 @@ let () =
let use_tele_message = fun payload ->
Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload));
let (packet_seq, ac_id, class_id, msg_id, values) = Tm_Pprz.values_of_payload payload in
- let msg = Tm_Pprz.message_of_id class_id msg_id in
+ let msg = Tm_Pprz.message_of_id ~class_id:class_id msg_id in
Tm_Pprz.message_send (string_of_int ac_id) msg.Pprz.name values in
ignore (PprzTransport.parse use_tele_message b)
@@ -57,7 +57,7 @@ let () =
try
let (msg_id, vs) = Dl_Pprz.values_of_string args.(0) in
let ac_id = Pprz.int_assoc "ac_id" vs in
- let payload = Dl_Pprz.payload_of_values ac_id (Pprz.class_id_of_msg_args args.(0)) msg_id vs in
+ let payload = Dl_Pprz.payload_of_values ac_id ~class_id:(Pprz.class_id_of_msg_args args.(0)) msg_id vs in
let buf = Pprz.Transport.packet payload in
fprintf o "%s%!" buf
with exc -> prerr_endline (Printexc.to_string exc) in
diff --git a/sw/ground_segment/tmtc/link.ml b/sw/ground_segment/tmtc/link.ml
index 2939b261aa0..f39acff41ce 100644
--- a/sw/ground_segment/tmtc/link.ml
+++ b/sw/ground_segment/tmtc/link.ml
@@ -207,7 +207,7 @@ let use_tele_message = fun ?udp_peername ?raw_data_size payload ->
try
let (packet_seq ,ac_id, class_id, msg_id, values) = Tm_Pprz.values_of_payload payload in
ignore (check_down_packet_sequence ac_id packet_seq);
- let msg = Tm_Pprz.message_of_id class_id msg_id in
+ let msg = Tm_Pprz.message_of_id ~class_id:class_id msg_id in
send_message_over_ivy (string_of_int ac_id) msg.Pprz.name values;
update_status ?udp_peername ac_id raw_data_size (msg.Pprz.name = "PONG")
with
@@ -431,7 +431,7 @@ let message_uplink = fun device ->
let class_id = Pprz.class_id_of_msg name in
let msg_id, _ = Dl_Pprz.message_of_name name in
let gen_packet_seq = get_up_packet_sequence ac_id in
- let s = Dl_Pprz.payload_of_values ~gen_packet_seq:gen_packet_seq my_id class_id msg_id vs in
+ let s = Dl_Pprz.payload_of_values ~gen_packet_seq:gen_packet_seq my_id ~class_id:class_id msg_id vs in
send ac_id device s High in
let set_forwarder = fun name ->
ignore (Dl_Pprz.message_bind name (forwarder name)) in
@@ -440,7 +440,7 @@ let message_uplink = fun device ->
Debug.call 'f' (fun f -> fprintf f "broadcast %s\n" name);
let class_id = Pprz.class_id_of_msg name in
let msg_id, _ = Dl_Pprz.message_of_name name in
- let payload = Dl_Pprz.payload_of_values ~gen_packet_seq:(get_up_packet_sequence 0) my_id class_id msg_id vs in
+ let payload = Dl_Pprz.payload_of_values ~gen_packet_seq:(get_up_packet_sequence 0) my_id ~class_id:class_id msg_id vs in
broadcast device payload Low in
let set_broadcaster = fun name ->
ignore (Dl_Pprz.message_bind name (broadcaster name)) in
@@ -459,7 +459,7 @@ let send_ping_msg = fun device ->
(fun ac_id status ->
let class_id = Pprz.class_id_of_msg "PING" in
let msg_id, _ = Dl_Pprz.message_of_name "PING" in
- let s = Dl_Pprz.payload_of_values ~gen_packet_seq:(get_up_packet_sequence ac_id) my_id class_id msg_id [] in
+ let s = Dl_Pprz.payload_of_values ~gen_packet_seq:(get_up_packet_sequence ac_id) my_id ~class_id:class_id msg_id [] in
send ac_id device s High;
status.last_ping <- Unix.gettimeofday ()
)
diff --git a/sw/ground_segment/tmtc/server.ml b/sw/ground_segment/tmtc/server.ml
index 27727a5afba..015b784a7c9 100644
--- a/sw/ground_segment/tmtc/server.ml
+++ b/sw/ground_segment/tmtc/server.ml
@@ -136,14 +136,13 @@ let log = fun ?timestamp logging ac_name msg_name values ->
(** Callback for a message from a registered A/C *)
let ac_msg = fun messages_xml logging ac_name ac ->
- (*let module Tele_Pprz = Pprz.MessagesOfXml(struct let xml = messages_xml let selection = "downlink" and mode = "type" end) in*) (* XGGDEBUG:DYNMOD: What is doing this? I NEED THE FULL MODULE TO USE MESSAGE_OF_ID *)
- let module Tele_Pprz = Pprz.Messages_of_type (struct let class_type = "downlink" end) in
+ let module Tele_Pprz = Pprz.MessagesOfXml(struct let xml = messages_xml let selection = "downlink" and mode = Pprz.Type and sel_class_id = None end) in
fun ts m ->
try
let timestamp = try Some (float_of_string ts) with _ -> None in
let (msg_id, values) = Tele_Pprz.values_of_string m in
let cls_id = Pprz.class_id_of_msg_args m in
- let msg = Tele_Pprz.message_of_id cls_id msg_id in
+ let msg = Tele_Pprz.message_of_id ~class_id:cls_id msg_id in
log ?timestamp logging ac_name msg.Pprz.name values;
Fw_server.log_and_parse ac_name ac msg values;
Rotorcraft_server.log_and_parse ac_name ac msg values
@@ -681,7 +680,7 @@ let raw_datalink = fun logging _sender vs ->
and m = Pprz.string_assoc "message" vs in
let msg_id, vs = Dl_Pprz.values_of_string_unsorted m in
let cls_id = Pprz.class_id_of_msg_args_unsorted m in
- let msg = Dl_Pprz.message_of_id cls_id msg_id in
+ let msg = Dl_Pprz.message_of_id ~class_id:cls_id msg_id in
Dl_Pprz.message_send dl_id msg.Pprz.name vs;
log logging ac_id msg.Pprz.name vs
diff --git a/sw/lib/ocaml/pprz.ml b/sw/lib/ocaml/pprz.ml
index 24a6e258fd9..74d9954e1bc 100644
--- a/sw/lib/ocaml/pprz.ml
+++ b/sw/lib/ocaml/pprz.ml
@@ -467,10 +467,13 @@ let offset_class_id = 2
let offset_msg_id = 3
let offset_fields = 4
+type messages_mode = Type | Name
+
module type CLASS_Xml = sig
val xml : Xml.xml
val selection : string
- val mode : string
+ val mode : messages_mode
+ val sel_class_id : int option
end
module type CLASS_NAME = sig
@@ -534,11 +537,15 @@ match Str.split semicolon s with
module type MESSAGES = sig
val messages : (msg_and_class_id, message) Hashtbl.t
+ val message_of_id : ?class_id:int -> message_id -> message
val message_of_name : string -> message_id * message
val values_of_payload : Serial.payload -> packet_seq * sender_id * class_id * message_id * values
(** [values_of_bin payload] Parses a raw payload, returns the
the A/C id, class id, message id and the list of (field_name, value) *)
+
+ val payload_of_values : ?gen_packet_seq:int -> sender_id -> ?class_id:int -> message_id -> values -> Serial.payload
+ (** [payload_of_values ?gen_packet_seq sender_id class_id id vs] Returns a payload *)
val values_of_string : string -> message_id * values
(** May raise [(Unknown_msg_name msg_name)] *)
@@ -567,73 +574,6 @@ module type MESSAGES = sig
will be applied on [sender_name] and attribute values of the values. *)
end
-module type MESSAGES_TYPE = sig
- val messages : (msg_and_class_id, message) Hashtbl.t
- val message_of_id : class_id -> message_id -> message
- val message_of_name : string -> message_id * message
-
- val values_of_payload : Serial.payload -> packet_seq * sender_id * class_id * message_id * values
- (** [values_of_bin payload] Parses a raw payload, returns the
- the Sender id, class id, message id and the list of (field_name, value) *)
-
- val payload_of_values : ?gen_packet_seq:int -> sender_id -> class_id -> message_id -> values -> Serial.payload
- (** [payload_of_values ?gen_packet_seq sender_id class_id id vs] Returns a payload *)
-
- val values_of_string : string -> message_id * values
- (** May raise [(Unknown_msg_name msg_name)] *)
-
- val values_of_string_unsorted : string -> message_id * values
- (** May raise [(Unknown_msg_name msg_name)] *)
-
- val string_of_message : ?sep:string -> message -> values -> string
- (** [string_of_message ?sep msg values] Default [sep] is space *)
-
- val message_send : ?timestamp:float -> string -> string -> values -> unit
- (** [message_send sender msg_name values] *)
-
- val message_bind : ?sender:string ->string -> (string -> values -> unit) -> Ivy.binding
- (** [message_bind ?sender msg_name callback] *)
-
- val message_answerer : string -> string -> (string -> values -> values) -> Ivy.binding
- (** [message_answerer sender msg_name callback] *)
-
- val message_req : string -> string -> values -> (string -> values -> unit) -> unit
- (** [message_answerer sender msg_name values receiver] Sends a request on the Ivy bus for the specified message. On reception, [receiver] will be applied on [sender_name] and expected values. *)
-end
-
-module type MESSAGES_NAME = sig
- val messages : (msg_and_class_id, message) Hashtbl.t
- val message_of_id : message_id -> message
- val message_of_name : string -> message_id * message
-
- val values_of_payload : Serial.payload -> packet_seq * sender_id * class_id * message_id * values
- (** [values_of_bin payload] Parses a raw payload, returns the
- the Sender id, class id, message id and the list of (field_name, value) *)
-
- val payload_of_values : ?gen_packet_seq:int -> sender_id -> message_id -> values -> Serial.payload
- (** [payload_of_values ?gen_packet_seq sender_id class_id id vs] Returns a payload *)
-
- val values_of_string : string -> message_id * values
- (** May raise [(Unknown_msg_name msg_name)] *)
-
- val values_of_string_unsorted : string -> message_id * values
- (** May raise [(Unknown_msg_name msg_name)] *)
-
- val string_of_message : ?sep:string -> message -> values -> string
- (** [string_of_message ?sep msg values] Default [sep] is space *)
-
- val message_send : ?timestamp:float -> string -> string -> values -> unit
- (** [message_send sender msg_name values] *)
-
- val message_bind : ?sender:string ->string -> (string -> values -> unit) -> Ivy.binding
- (** [message_bind ?sender msg_name callback] *)
-
- val message_answerer : string -> string -> (string -> values -> values) -> Ivy.binding
- (** [message_answerer sender msg_name callback] *)
-
- val message_req : string -> string -> values -> (string -> values -> unit) -> unit
- (** [message_answerer sender msg_name values receiver] Sends a request on the Ivy bus for the specified message. On reception, [receiver] will be applied on [sender_name] and expected values. *)
-end
module MessagesOfXml(Class:CLASS_Xml) = struct
let max_length = 256
@@ -680,7 +620,7 @@ module MessagesOfXml(Class:CLASS_Xml) = struct
let messages_loaded =
try
match Class.mode with
- | "type" ->
+ | Type ->
let class_structs = List.map (fun _class ->
{class_id = int_of_string (ExtXml.attrib _class "id") ; class_name = ExtXml.attrib _class "name" ; class_type = ExtXml.attrib _class "type" ; class_xml = _class }
) (Xml.children msg_xml) in
@@ -694,7 +634,7 @@ module MessagesOfXml(Class:CLASS_Xml) = struct
Hashtbl.add classes_by_id sel.class_id by_id
) !selected_classes);
true
- | "name" ->
+ | Name ->
let class_structs = List.map (fun _class ->
{class_id = int_of_string (ExtXml.attrib _class "id") ; class_name = ExtXml.attrib _class "name" ; class_type = ExtXml.attrib _class "type" ; class_xml = _class }
) (Xml.children msg_xml) in
@@ -705,17 +645,22 @@ module MessagesOfXml(Class:CLASS_Xml) = struct
let by_id = parse_class sel in
Hashtbl.add classes_by_id sel.class_id by_id
) !selected_classes);
- true
- | _ -> failwith ("Pprz->messages: cannot initialize with mode different than 'name' or 'type' ")
+ true
with
| Not_found -> failwith ("Pprz->messages: error loading classes and messages (Not_found) ")
| e -> failwith (sprintf "Pprz->messages: error loading classes and messages (Exception: %s) " (Printexc.to_string e))
-
- let message_of_id_ = fun class_id id ->
+
+ let check_mode = fun class_id ->
+ match class_id with
+ | None -> if (Class.mode = Name) then match Class.sel_class_id with None -> failwith("") | Some cls_id-> cls_id else failwith ("Pprz.Messages class_id not defined ")
+ | Some cls_id -> cls_id
+
+ let message_of_id = fun ?class_id id ->
try
- let sel_class = Hashtbl.find classes_by_id class_id in
- Hashtbl.find sel_class id
- with Not_found -> fprintf stderr "Pprz->messages.message_of_id: class of id: %d or message of id :%d not found\n%!" class_id id; raise Not_found
+ let cls_id = check_mode class_id in
+ let sel_class = Hashtbl.find classes_by_id cls_id in
+ Hashtbl.find sel_class id
+ with Not_found -> failwith ("Pprz.Messages message not found")
let message_of_name = fun name ->
@@ -731,7 +676,7 @@ module MessagesOfXml(Class:CLASS_Xml) = struct
let sender_id = Char.code buffer.[offset_sender_id] in
let packet_seq = Char.code buffer.[offset_packet_seq] in
let class_id = Char.code buffer.[offset_class_id] in
- let message = message_of_id_ class_id id in
+ let message = message_of_id ~class_id:class_id id in
Debug.call 'T' (fun f -> fprintf f "Pprz.values id=%d\n" id);
let rec loop = fun index fields ->
match fields with
@@ -747,9 +692,10 @@ module MessagesOfXml(Class:CLASS_Xml) = struct
with
Invalid_argument("index out of bounds") ->
failwith (sprintf "Pprz.values_of_payload, wrong argument: %s" (Debug.xprint buffer))
-
- let payload_of_values_ = fun ?gen_packet_seq sender_id class_id id values ->
- let message = message_of_id_ class_id id in
+
+ let payload_of_values = fun ?gen_packet_seq sender_id ?class_id id values ->
+ let cls_id = check_mode class_id in
+ let message = message_of_id ~class_id:cls_id id in
(** The actual length is computed from the values *)
let p = String.make max_length '#' in
@@ -757,7 +703,7 @@ module MessagesOfXml(Class:CLASS_Xml) = struct
p.[offset_msg_id] <- Char.chr id;
p.[offset_sender_id] <- Char.chr sender_id;
p.[offset_packet_seq] <- Char.chr (match gen_packet_seq with None -> 0 | Some some -> some);
- p.[offset_class_id] <- Char.chr class_id;
+ p.[offset_class_id] <- Char.chr cls_id;
let i = ref offset_fields in
List.iter
(fun (field_name, field) ->
@@ -889,10 +835,9 @@ module Messages_of_type(Class:CLASS_TYPE) = struct
include MessagesOfXml(struct
let xml = messages_xml ()
let selection = Class.class_type
- let mode = "type"
+ let mode = Type
+ let sel_class_id = None
end)
- let message_of_id = fun class_id message_id -> message_of_id_ class_id message_id
- let payload_of_values = fun ?gen_packet_seq sender_id class_id id values -> payload_of_values_ ?gen_packet_seq sender_id class_id id values
end
type class_id_name = {
@@ -912,11 +857,9 @@ module Messages_of_name(Class:CLASS_NAME) = struct
include MessagesOfXml(struct
let xml = messages_xml ()
let selection = Class.class_name
- let mode = "name"
+ let mode = Name
+ let sel_class_id = Some (class_id_of_name Class.class_name)
end)
- let sel_class_id = class_id_of_name Class.class_name
- let message_of_id = fun message_id -> message_of_id_ sel_class_id message_id
- let payload_of_values = fun ?gen_packet_seq sender_id id values -> payload_of_values_ ?gen_packet_seq sender_id sel_class_id id values
end
diff --git a/sw/lib/ocaml/pprz.mli b/sw/lib/ocaml/pprz.mli
index 404f620a74b..20939242707 100644
--- a/sw/lib/ocaml/pprz.mli
+++ b/sw/lib/ocaml/pprz.mli
@@ -146,10 +146,13 @@ module type CLASS_TYPE = sig
val class_type : string
end
+type messages_mode = Type | Name
+
module type CLASS_Xml = sig
val xml : Xml.xml
val selection : string
- val mode : string
+ val mode : messages_mode
+ val sel_class_id : int option
end
type msg_and_class_id = {
@@ -168,49 +171,14 @@ val class_id_of_msg_args_unsorted : string -> class_id
module type MESSAGES = sig
val messages : (msg_and_class_id, message) Hashtbl.t
+ val message_of_id : ?class_id:int -> message_id -> message
val message_of_name : string -> message_id * message
val values_of_payload : Serial.payload -> packet_seq * sender_id * class_id * message_id * values
(** [values_of_bin payload] Parses a raw payload, returns the
the A/C id, class id, message id and the list of (field_name, value) *)
-
- val values_of_string : string -> message_id * values
- (** May raise [(Unknown_msg_name msg_name)] *)
-
- val values_of_string_unsorted : string -> message_id * values
- (** May raise [(Unknown_msg_name msg_name)] *)
-
- val string_of_message : ?sep:string -> message -> values -> string
- (** [string_of_message ?sep msg values] Default [sep] is space *)
-
- val message_send : ?timestamp:float -> string -> string -> values -> unit
- (** [message_send sender msg_name values] *)
-
- val message_bind : ?sender:string ->string -> (string -> values -> unit) -> Ivy.binding
- (** [message_bind ?sender msg_name callback] *)
-
- val message_answerer : string -> string -> (string -> values -> values) -> Ivy.binding
- (** [message_answerer sender msg_name callback] Set a handler for a
- [message_req] (which will send a [msg_name]_REQ message).
- [callback asker args] must return the list of attributes of the answer. *)
-
- val message_req : string -> string -> values -> (string -> values -> unit) -> unit
- (** [message_req sender msg_name values receiver] Sends a request on the Ivy
- bus for the specified message. A [msg_name]_REQ message is send and a
- [msg_name] message is expected for the reply. On reception, [receiver]
- will be applied on [sender_name] and attribute values of the values. *)
-end
-
-module type MESSAGES_TYPE = sig
- val messages : (msg_and_class_id, message) Hashtbl.t
- val message_of_id : class_id -> message_id -> message
- val message_of_name : string -> message_id * message
-
- val values_of_payload : Serial.payload -> packet_seq * sender_id * class_id * message_id * values
- (** [values_of_bin payload] Parses a raw payload, returns the
- the A/C id, class id, message id and the list of (field_name, value) *)
-
- val payload_of_values : ?gen_packet_seq:int -> sender_id -> class_id -> message_id -> values -> Serial.payload
+
+ val payload_of_values : ?gen_packet_seq:int -> sender_id -> ?class_id:int -> message_id -> values -> Serial.payload
(** [payload_of_values ?gen_packet_seq sender_id class_id id vs] Returns a payload *)
val values_of_string : string -> message_id * values
@@ -240,41 +208,7 @@ module type MESSAGES_TYPE = sig
will be applied on [sender_name] and attribute values of the values. *)
end
-module type MESSAGES_NAME = sig
- val messages : (msg_and_class_id, message) Hashtbl.t
- val message_of_id : message_id -> message
- val message_of_name : string -> message_id * message
-
- val values_of_payload : Serial.payload -> packet_seq * sender_id * class_id * message_id * values
- (** [values_of_bin payload] Parses a raw payload, returns the
- the Sender id, class id, message id and the list of (field_name, value) *)
-
- val payload_of_values : ?gen_packet_seq:int -> sender_id -> message_id -> values -> Serial.payload
- (** [payload_of_values ?gen_packet_seq sender_id class_id id vs] Returns a payload *)
-
- val values_of_string : string -> message_id * values
- (** May raise [(Unknown_msg_name msg_name)] *)
-
- val values_of_string_unsorted : string -> message_id * values
- (** May raise [(Unknown_msg_name msg_name)] *)
-
- val string_of_message : ?sep:string -> message -> values -> string
- (** [string_of_message ?sep msg values] Default [sep] is space *)
-
- val message_send : ?timestamp:float -> string -> string -> values -> unit
- (** [message_send sender msg_name values] *)
-
- val message_bind : ?sender:string ->string -> (string -> values -> unit) -> Ivy.binding
- (** [message_bind ?sender msg_name callback] *)
-
- val message_answerer : string -> string -> (string -> values -> values) -> Ivy.binding
- (** [message_answerer sender msg_name callback] *)
-
- val message_req : string -> string -> values -> (string -> values -> unit) -> unit
- (** [message_answerer sender msg_name values receiver] Sends a request on the Ivy bus for the specified message. On reception, [receiver] will be applied on [sender_name] and expected values. *)
-end
-
-module Messages_of_type : functor (Class : CLASS_TYPE) -> MESSAGES_TYPE
-module Messages_of_name : functor (Class : CLASS_NAME) -> MESSAGES_NAME
+module Messages_of_type : functor (Class : CLASS_TYPE) -> MESSAGES
+module Messages_of_name : functor (Class : CLASS_NAME) -> MESSAGES
module MessagesOfXml : functor (Class : CLASS_Xml) -> MESSAGES
diff --git a/sw/logalizer/play_core.ml b/sw/logalizer/play_core.ml
index e55ae96affd..78d698fd6ec 100644
--- a/sw/logalizer/play_core.ml
+++ b/sw/logalizer/play_core.ml
@@ -149,7 +149,7 @@ let run = fun serial_port log adj i0 speed no_gui ->
| Some channel ->
try
let msg_id, vs = Tm_Pprz.values_of_string m in
- let payload = Tm_Pprz.payload_of_values (int_of_string ac) (Pprz.class_id_of_msg_args m) msg_id vs in
+ let payload = Tm_Pprz.payload_of_values (int_of_string ac) ~class_id:(Pprz.class_id_of_msg_args m) msg_id vs in
let buf = Pprz.Transport.packet payload in
Debug.call 'o' (fun f -> fprintf f "%s\n" (Debug.xprint buf));
fprintf channel "%s%!" buf
diff --git a/sw/logalizer/plot.ml b/sw/logalizer/plot.ml
index 360ce28718b..9c7934e504d 100644
--- a/sw/logalizer/plot.ml
+++ b/sw/logalizer/plot.ml
@@ -679,9 +679,8 @@ let load_log = fun ?export ?factor (plot:plot) (menubar:GMenu.menu_shell GMenu.f
let class_type = "downlink" in
Debug.call 'p' (fun f -> fprintf f "class_type: %s\n" class_type);
- (*let module M = struct let selection = class_type and mode = "type" let xml = protocol end in *)(* XGGDEBUG:DYNMOD: Why only MessagesOfXml and not the full module? I need to use message_of_id and it's in the full module *)
- (*let module P = Pprz.MessagesOfXml(M) in *)
- let module P = Pprz.Messages_of_type (struct let class_type = class_type end) in
+ let module M = struct let selection = class_type and mode = Pprz.Type and sel_class_id = None let xml = protocol end in
+ let module P = Pprz.MessagesOfXml(M) in
let f =
try
@@ -730,7 +729,7 @@ let load_log = fun ?export ?factor (plot:plot) (menubar:GMenu.menu_shell GMenu.f
| scalar ->
Hashtbl.add fields f (t, scalar))
vs;
- let msg_temp = P.message_of_id cls_id msg_id in
+ let msg_temp = P.message_of_id ~class_id:cls_id msg_id in
let msg_name = msg_temp.Pprz.name in
raw_msgs := (t, msg_name, vs) :: !raw_msgs
)
@@ -751,7 +750,7 @@ let load_log = fun ?export ?factor (plot:plot) (menubar:GMenu.menu_shell GMenu.f
(* First sort by message id *)
let l = ref [] in
- Hashtbl.iter (fun msg_ids fields -> l := (P.message_of_id msg_ids.cls_id msg_ids.msg_id, fields):: !l) msgs;
+ Hashtbl.iter (fun msg_ids fields -> l := (P.message_of_id ~class_id:msg_ids.cls_id msg_ids.msg_id, fields):: !l) msgs;
let msgs = List.sort (fun (a,_) (b,_) -> compare a b) !l in
diff --git a/sw/logalizer/sd2log.ml b/sw/logalizer/sd2log.ml
index 95c6492a33d..90f2b4523c2 100644
--- a/sw/logalizer/sd2log.ml
+++ b/sw/logalizer/sd2log.ml
@@ -141,7 +141,7 @@ let convert_file = fun file ->
if ac_id <> !single_ac_id && log_msg.Logpprz.source = 0 then
fprintf stderr "Discarding message with ac_id %d, previous one was %d\n%!" ac_id !single_ac_id
else
- let msg_descr = message_of_id log_msg class_id msg_id in
+ let msg_descr = message_of_id log_msg ~class_id:class_id msg_id in
let timestamp = Int32.to_float log_msg.Logpprz.timestamp /. 1e4 in
fprintf f_out "%.4f %d %s\n" timestamp ac_id (string_of_message log_msg msg_descr vs);
diff --git a/sw/simulator/sitl.ml b/sw/simulator/sitl.ml
index 76b9ae29a16..62abc7c31ae 100644
--- a/sw/simulator/sitl.ml
+++ b/sw/simulator/sitl.ml
@@ -167,7 +167,7 @@ module Make (A:Data.MISSION) (FM: FlightModel.SIG) = struct
let get_message = fun name link_mode _sender vs ->
let set = fun () ->
let msg_id, _ = Dl_Pprz.message_of_name name in
- let s = Dl_Pprz.payload_of_values ground_id (Pprz.class_id_of_msg name) msg_id vs in
+ let s = Dl_Pprz.payload_of_values ground_id ~class_id:(Pprz.class_id_of_msg name) msg_id vs in
set_message (Serial.string_of_payload s) in
let ac_id = Pprz.int_assoc "ac_id" vs in
match link_mode with