diff --git a/conf/gcs/tmp_papgets.xml b/conf/gcs/tmp_papgets.xml new file mode 100644 index 0000000000..ad387a6a0a --- /dev/null +++ b/conf/gcs/tmp_papgets.xml @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 4cab821936..f313fea74c 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/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 _main = + +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 () = 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; diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 27ff83b2ee..0f2bff2d57 100644 --- a/sw/lib/ocaml/Makefile +++ b/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) diff --git a/sw/lib/ocaml/papget.ml b/sw/lib/ocaml/papget.ml new file mode 100644 index 0000000000..0d75a5161f --- /dev/null +++ b/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