[gcs] adjust video papget to current zoom

fix #889

sw/ground_segment/cockpit/gcs.ml

@@ -609,7 +609,7 @@ let save_layout = fun filename contents ->
 let listen_dropped_papgets = fun (geomap:G.widget) ->
   let dnd_targets = [ { Gtk.target = "STRING"; flags = []; info = 0 } ] in
   geomap#canvas#drag#dest_set dnd_targets ~actions:[`COPY];
-  ignore (geomap#canvas#drag#connect#data_received ~callback:(Papgets.dnd_data_received geomap#still))
+  ignore (geomap#canvas#drag#connect#data_received ~callback:(Papgets.dnd_data_received geomap#still geomap#zoom_adj))
 
 
 
@@ -716,7 +716,7 @@ let () =
 
   (** packing papgets *)
   let papgets = try find_widget_children "map2d" the_layout with Not_found -> [] in
-  List.iter (Papgets.create geomap#still) papgets;
+  List.iter (Papgets.create geomap#still geomap#zoom_adj) papgets;
   listen_dropped_papgets geomap;
 
   let save_layout = fun () ->

sw/ground_segment/cockpit/papgets.ml

@@ -117,7 +117,7 @@ let ac_id_prop = fun config ->
     [PC.property "ac_id" (PC.get_property "ac_id" config)]
   with _ -> []
 
-let create = fun canvas_group papget ->
+let create = fun canvas_group zoom_adj papget ->
   try
     let type_ = ExtXml.attrib papget "type"
     and display = ExtXml.attrib papget "display"
@@ -203,7 +203,7 @@ let create = fun canvas_group papget ->
             | _ -> failwith (sprintf "Unexpected papget display: %s" display) in
 
         let properties = locked papget in
-        let p = new Papget.canvas_video_plugin_item properties renderer in
+        let p = new Papget.canvas_video_plugin_item properties renderer zoom_adj in
         let p = (p :> Papget.item) in
         register_papget p
 
@@ -220,7 +220,7 @@ let parse_message_dnd =
     match Str.split sep s with
         [s; c; m; f;scale] -> (s, c, m, f,scale)
       | _ -> raise (Parse_message_dnd (Printf.sprintf "parse_dnd: %s" s))
-let dnd_data_received = fun canvas_group _context ~x ~y data ~info ~time ->
+let dnd_data_received = fun canvas_group zoom_adj _context ~x ~y data ~info ~time ->
   try (* With the format sent by Messages *)
     let (sender, _class_name, msg_name, field_name,scale) = parse_message_dnd data#data in
     let attrs =
@@ -232,7 +232,7 @@ let dnd_data_received = fun canvas_group _context ~x ~y data ~info ~time ->
         Papget_common.property "ac_id" sender;
         Papget_common.property "scale" scale ] in
     let papget_xml = Xml.Element ("papget", attrs, props) in
-    create canvas_group papget_xml
+    create canvas_group zoom_adj papget_xml
   with
       Parse_message_dnd _ ->
         try (* XML spec *)
@@ -240,6 +240,6 @@ let dnd_data_received = fun canvas_group _context ~x ~y data ~info ~time ->
     (* Add x and y attributes *)
           let attrs = Xml.attribs xml @ ["x", string_of_int x; "y", string_of_int y] in
           let papget_xml = Xml.Element (Xml.tag xml,attrs,Xml.children xml) in
-          create canvas_group papget_xml
+          create canvas_group zoom_adj papget_xml
         with
             exc -> prerr_endline (Printexc.to_string exc)

sw/ground_segment/cockpit/papgets.mli

@@ -24,7 +24,7 @@
 
 val dump_store : bool -> Xml.xml list
 val has_papgets : unit -> bool
-val create : #GnoCanvas.group -> Xml.xml -> unit
+val create : #GnoCanvas.group -> GData.adjustment -> Xml.xml -> unit
 val dnd_data_received :
-  #GnoCanvas.group ->
+  #GnoCanvas.group -> GData.adjustment ->
   'a -> x:int -> y:int -> < data : string; .. > -> info:'b -> time:'c -> unit