Merge pull request #1020 from paparazzi/messages_drag_sensitivity

Messages drag sensitivity

sw/ground_segment/tmtc/messages.ml

@@ -31,6 +31,8 @@ let led_delay = 500 (* Time in milliseconds while the green led is displayed *)
 
 let dnd_targets = [ { Gtk.target = "STRING"; flags = []; info = 0} ]
 
+let help_text = "Drag-and-drop field on:\n\t- Real-Time Plotter to plot a curve\n\t- GCS map to display as a papget"
+
 let pipe_regexp = Str.regexp "|"
 let values_of_field = fun field ->
   try
@@ -39,7 +41,7 @@ let values_of_field = fun field ->
       _ -> [||]
 
 (** Display one page for a message *)
-let one_page = fun sender class_name (notebook:GPack.notebook) bind m ->
+let one_page = fun sender class_name (notebook:GPack.notebook) (help_label:GObj.widget) (window:GWindow.window) bind m ->
   let id = (Xml.attrib m "name") in
   let h = GPack.hbox () in
   h#misc#set_property "name" (`STRING (Some id));
@@ -61,6 +63,8 @@ let one_page = fun sender class_name (notebook:GPack.notebook) bind m ->
           let format_ = try Some (Xml.attrib f "format") with _ -> None in
           let h = GPack.hbox ~packing:v#pack () in
           let field_label = GButton.button ~label:name ~packing:h#pack () in
+          let tips = GData.tooltips () in
+          tips#set_tip field_label#coerce ~text:help_text;
 
           let value = ref "XXXX" in
           let l = GMisc.label ~text: !value ~packing:h#pack () in
@@ -89,16 +93,27 @@ let one_page = fun sender class_name (notebook:GPack.notebook) bind m ->
           field_label#drag#source_set dnd_targets ~modi:[`BUTTON1] ~actions:[`COPY];
           let data_get = fun _ (sel:GObj.selection_context) ~info ~time ->
             let scale = Pprz.alt_unit_coef_of_xml ~auto:"display" f in
-            let field_descr =
+            let v = List.hd (Str.split (Str.regexp " ") l#text) in (* get value *)
-              if Pprz.is_array_type type_ then
+            let nb = List.length (Str.split (Str.regexp ",") v) in (* get number of values if array *)
-                match GToolbox.input_string ~title:"Index of value to drag" ~text:"0" "Index in the array ?" with
+            let range = if nb > 1 then sprintf "0-%d" (nb-1) else "0" in
-                    None -> field_name
+            if Pprz.is_array_type type_ then
-                  | Some i -> sprintf "%s[%s]" field_name i
+              match GToolbox.input_string ~title:"Index of value to drag" ~text:range "Index or range in the array ?" with
+                None -> ()
+              | Some i -> sel#return (sprintf "%s:%s:%s:%s[%s]:%s" sender class_name id field_name i scale)
               else
-                field_name in
+                sel#return (sprintf "%s:%s:%s:%s:%s" sender class_name id field_name scale)
-            sel#return (sprintf "%s:%s:%s:%s:%s" sender class_name id field_descr scale) in
+          in
           ignore (field_label#drag#connect#data_get ~callback:data_get);
 
+          (* hide notebook and display help during drag *)
+          let begin_drag = fun _ ->
+            notebook#coerce#misc#hide ();
+            help_label#misc#show ();
+            window#resize ~width:300 ~height:50
+          in
+          ignore (field_label#drag#connect#beginning ~callback:begin_drag);
+          ignore (field_label#drag#connect#ending ~callback:(fun _ -> notebook#coerce#misc#show (); help_label#misc#hide ()));
+
           (update, display_value)::rest
         with
             _ ->
@@ -155,7 +170,7 @@ let one_page = fun sender class_name (notebook:GPack.notebook) bind m ->
   in
   bind id display
 
-let rec one_class = fun (notebook:GPack.notebook) (ident, xml_class, sender) ->
+let rec one_class = fun (notebook:GPack.notebook) (help_label:GObj.widget) (window:GWindow.window) (ident, xml_class, sender) ->
   let class_name = (Xml.attrib xml_class "name") in
   let messages = Xml.children xml_class in
   let module P = Pprz.Messages (struct let name = class_name end) in
@@ -166,7 +181,7 @@ let rec one_class = fun (notebook:GPack.notebook) (ident, xml_class, sender) ->
       let get_one = fun sender _vs ->
         if not (Hashtbl.mem senders sender) then begin
           Hashtbl.add senders sender ();
-          one_class notebook (ident,  xml_class, Some sender)
+          one_class notebook help_label window (ident,  xml_class, Some sender)
         end in
       List.iter
         (fun m -> ignore (P.message_bind (Xml.attrib m "name") get_one))
@@ -182,7 +197,7 @@ let rec one_class = fun (notebook:GPack.notebook) (ident, xml_class, sender) ->
 
       (** Forall messages in the class *)
       let messages = list_sort (fun x -> Xml.attrib x "name") messages in
-      List.iter (fun m -> ignore (one_page sender_name class_name class_notebook bind m)) messages
+      List.iter (fun m -> ignore (one_page sender_name class_name class_notebook help_label window bind m)) messages
 
 
 
@@ -207,8 +222,10 @@ let _ =
   window#set_default_size ~width:200 ~height:50;
   let quit = fun () -> GMain.Main.quit (); exit 0 in
   ignore (window#connect#destroy ~callback:quit);
+  let vbox = GPack.vbox ~packing:window#add () in
 
-  let notebook = GPack.notebook ~packing:window#add ~tab_pos:`TOP () in
+  let notebook = GPack.notebook ~packing:vbox#pack ~tab_pos:`TOP () in
+  let help_label = GMisc.label ~text:help_text ~packing:vbox#pack ~show:false () in
 
   (** Get the XML description of the required classes *)
   let xml_classes =
@@ -226,7 +243,7 @@ let _ =
       !classes in
 
   (* Insert the message classes in the notebook *)
-  List.iter (one_class notebook) xml_classes;
+  List.iter (one_class notebook help_label#coerce window) xml_classes;
 
   (** Start the main loop *)
   window#show ();

sw/logalizer/plotter.ml

@@ -517,7 +517,28 @@ let rec plot_window = fun window ->
     let factor =  Ocaml_tools.affine_transform factor#text in
     try
       let name = data#data in
-      add_curve ~factor name
+      let (sender, class_name, msg_name, field_descr, (a',b')) = parse_dnd name in
+      (* test if several curves need to be added with x[min-max] format *)
+      if Str.string_match (Str.regexp "\\([^\\.]+\\)\\[\\([0-9]+\\)-\\([0-9]+\\)\\]") field_descr 0 then
+        begin
+          (* get name and range in correct order *)
+          let field_name = Str.matched_group 1 field_descr
+          and min_range = int_of_string (Str.matched_group 2 field_descr)
+          and max_range = int_of_string (Str.matched_group 3 field_descr) in
+          let min_range, max_range = if min_range > max_range then
+            max_range, min_range
+          else
+            min_range, max_range
+          in
+          (* add all curves *)
+          for i = min_range to max_range do
+            let offset = if a' <> 0. then sprintf "+%.2f" b' else "" in
+            let name = (sprintf "%s:%s:%s:%s[%d]:%f%s" sender class_name msg_name field_name i a' offset) in
+            add_curve ~factor name
+          done
+        end
+      else
+        add_curve ~factor name
     with
       exc -> prerr_endline (Printexc.to_string exc)
     in