Papgets are coming ...

conf/gcs/tmp_papgets.xml

@@ -0,0 +1,17 @@
+<!DOCTYPE layout SYSTEM "layout.dtd">
+
+<layout width="1024" height="768">
+ <rows>
+  <widget size="500" name="map2d">
+    <papget field="ESTIMATOR:z" x="10" y="150" format="Alt:%.0fm"/>
+    <papget field="ESTIMATOR:z_dot" x="10" y="200" format="Climb:%.1fm/s"/>
+  </widget>
+  <columns>
+   <rows size="375">
+    <widget size="200" name="strips"/>
+   </rows>
+   <widget size="400" name="aircraft"/>
+   <widget name="alarms"/>
+  </columns>
+ </rows>
+</layout>

sw/ground_segment/cockpit/gcs.ml

@@ -450,11 +450,43 @@ and pack_list = fun resize orientation xmls widgets packing ->
       pack_widgets orientation x widgets paned#add1;
       pack_list resize orientation xs widgets paned#add2
 
+let rec find_widget_children = fun name xml ->
+  let xmls = Xml.children xml in
+  match String.lowercase (Xml.tag xml) with
+    "widget" when ExtXml.attrib xml "name" = name -> xmls
+  | "rows" | "colums" ->
+      let rec loop = function
+	  [] -> raise Not_found
+	| x::xs ->
+	    try find_widget_children name x with
+	      Not_found -> loop xs in
+      loop xmls
+  | _ -> raise Not_found
+
+      
+let pack_papget =
+  let sep = Str.regexp ":" in
+  fun geomap papget ->
+    let field = ExtXml.attrib papget "field"
+    and x = ExtXml.float_attrib papget "x"
+    and y = ExtXml.float_attrib papget "y" in
+    match Str.split sep field with
+      [msg_name; field_name] ->
+	let msg_listener = new Papget.message msg_name in
+	let ct = new Papget.canvas_text geomap#still x y msg_listener field_name  in
+	begin
+	  try
+	    let format = ExtXml.attrib papget "format" in
+	    ct#set_renderer (fun x -> sprintf (Obj.magic format) (float_of_string x))
+	  with
+	    _ -> ()
+	end
+    | _ -> failwith (sprintf "pack_papget: %s" field)
 
 
 
-
+(************************** MAIN ********************************************)
-let _main =
+let () =
   let file_to_edit = ref "" in
   Arg.parse options
     (fun x -> if !edit then file_to_edit := x else Printf.fprintf stderr "Warning: Don't do anything with '%s'\n%!" x)
@@ -528,8 +560,12 @@ let _main =
 		 "altgraph", alt_graph#coerce (*alt_frame#coerce*);
 	   "plugin", plugin_frame#coerce] in
 
+  let the_layout = ExtXml.child layout "0" in
+  pack_widgets `HORIZONTAL the_layout widgets window#add;
 
-  pack_widgets `HORIZONTAL (ExtXml.child layout "0") widgets window#add;
+  (** packing mapgets *)
+  let papgets = find_widget_children "map2d" the_layout in
+  List.iter (pack_papget geomap) papgets;
 
   if !mplayer <> "" then
     plugin_window := sprintf "mplayer -nomouseinput %s -wid " !mplayer;

sw/lib/ocaml/Makefile

@@ -32,7 +32,7 @@ SRC = debug.ml base64.ml serial.ml ocaml_tools.ml extXml.ml env.ml xml2h.ml latl
 CMO = $(SRC:.ml=.cmo)
 CMX = $(SRC:.ml=.cmx)
 
-XSRC = platform.ml wind_sock.ml mapCanvas.ml mapWaypoints.ml mapTrack.ml mapGoogle.ml mapIGN.ml ml_gtk_drag.o xmlEdit.ml mapFP.ml
+XSRC = platform.ml wind_sock.ml papget.ml mapCanvas.ml mapWaypoints.ml mapTrack.ml mapGoogle.ml mapIGN.ml ml_gtk_drag.o xmlEdit.ml mapFP.ml
 XCMO = $(XSRC:.ml=.cmo)
 XCMX = $(XSRC:.ml=.cmx)
 

sw/lib/ocaml/papget.ml

@@ -0,0 +1,35 @@
+open Printf
+
+class message = fun ?(class_name="telemetry") msg_name ->
+  object
+    val mutable callbacks = []
+    method connect = fun f cb -> callbacks <- (f, cb) :: callbacks
+    initializer
+      let module P = Pprz.Messages (struct let name = class_name end) in
+      ignore (P.message_bind msg_name 
+	(fun _sender values -> 
+	  List.iter 
+	    (fun (field_name, cb) -> 
+	      let field = Pprz.string_assoc field_name values in
+	      cb field) 
+	    callbacks))
+  end
+
+class field = fun msg_obj field_name ->
+  object (self)
+    val mutable last_val = ""
+    method store = fun value -> last_val <- value
+    initializer
+      msg_obj#connect field_name self#store
+  end
+
+class canvas_text = fun ?(text="") canvas_group x y msg_obj field_name ->
+  let item = GnoCanvas.text ~x ~y ~text canvas_group in
+  object
+    inherit field msg_obj field_name as super
+    val mutable renderer = fun x -> x
+    method set_renderer = fun f -> renderer <- f 
+    method store = fun value ->
+      super#store value;
+      item#set [`SIZE_POINTS 25.; `TEXT (renderer value); `FILL_COLOR "green"; `ANCHOR `NW]
+  end