diff --git a/conf/gcs/layout.dtd b/conf/gcs/layout.dtd index 78e6193c5d..2f113a8ff1 100644 --- a/conf/gcs/layout.dtd +++ b/conf/gcs/layout.dtd @@ -2,8 +2,8 @@ - - + + - diff --git a/conf/gcs/tmp_papgets.xml b/conf/gcs/tmp_papgets.xml index 82ee618ea9..d502a2af49 100644 --- a/conf/gcs/tmp_papgets.xml +++ b/conf/gcs/tmp_papgets.xml @@ -4,28 +4,34 @@ - - - - + + + + - - + + - - - + + + + - - + + + + + + diff --git a/data/pictures/gcs_icons/takeoff.png b/data/pictures/gcs_icons/takeoff.png index f820995c35..ecbc8e6fc1 100644 Binary files a/data/pictures/gcs_icons/takeoff.png and b/data/pictures/gcs_icons/takeoff.png differ diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index e0cd0294d6..ff38dc1044 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -464,17 +464,46 @@ let rec find_widget_children = fun name xml -> | _ -> raise Not_found -let get_papget_attr = fun xml attr_name -> - let attr = ExtXml.child ~select:(fun x -> ExtXml.attrib x "name" = attr_name) xml "attr" in - ExtXml.attrib attr "value" +let rec replace_widget_children = fun name children xml -> + let xmls = Xml.children xml + and tag = String.lowercase (Xml.tag xml) in + match tag with + "widget" -> + Xml.Element("widget", + Xml.attribs xml, + if ExtXml.attrib xml "name" = name then children else xmls) + | "rows" | "columns" -> + let rec loop = function + [] -> [] + | x::xs -> + replace_widget_children name children x :: loop xs in + Xml.Element(tag, + Xml.attribs xml, + loop xmls) + | x -> xml + + let try_fun = fun f -> try f () with _ -> () +let papget = fun type_ display attrs -> + Xml.Element ("papget", ["type", type_; "display", display], attrs) +let papgets = Hashtbl.create 5 +let register_papget = fun p p -> Hashtbl.add papgets p p +let papgets_config = fun () -> + Hashtbl.fold + (fun _ p r -> + if not p#deleted then + p#config ()::r + else + r) + papgets + [] let papget_listener = let sep = Str.regexp ":" in fun papget -> try - let field = get_papget_attr papget "field" in + let field = Papget.get_property "field" papget in match Str.split sep field with [msg_name; field_name] -> (new Papget.message msg_name, field_name) @@ -487,31 +516,84 @@ let pack_papget = let type_ = ExtXml.attrib papget "type" and display = ExtXml.attrib papget "display" and x = ExtXml.float_attrib papget "x" - and y = ExtXml.float_attrib papget "y" in + and y = ExtXml.float_attrib papget "y" + and config = Xml.children papget in match type_ with "message_field" -> let msg_listener, field_name = papget_listener papget and renderer = match display with "text" -> - let renderer = new Papget.canvas_text geomap#still x y in - try_fun (fun () ->renderer#set_format (get_papget_attr papget "format") ); - try_fun (fun () ->renderer#set_size (float_of_string (get_papget_attr papget "size")) ); - try_fun (fun () ->renderer#set_color (get_papget_attr papget "color") ); - (renderer :> Papget.renderer) + (new Papget.canvas_text ~config geomap#still x y :> Papget.renderer) - | "ruler" -> - let h = try Some (float_of_string (get_papget_attr papget "height")) with _ -> None in - (new Papget.canvas_ruler geomap#still ?h x y :> Papget.renderer) + | "ruler" -> + (new Papget.canvas_ruler geomap#still ~config x y :> Papget.renderer) | _ -> failwith (sprintf "Unexpected papget display: %s" display) in - ignore (new Papget.canvas_display_item msg_listener field_name renderer) - | "variable_setting" | "goto_block" -> - fprintf stderr "Papget %s soon\n%!" type_ + let p = new Papget.canvas_display_item msg_listener field_name renderer in + let p = (p :> Papget.item) in + register_papget p p + | "goto_block" -> +(*** + let button = GButton.button () + and icon = Papget.get_property "icon" papget in + let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in + ignore (GMisc.image ~pixbuf ~packing:button#add ()); + let renderer = (new Papget.widget_renderer "Button" button#coerce geomap#still ~config x y :> Papget.renderer) in +***) + let renderer = + match display with + "button" -> + (new Papget.canvas_button geomap#still ~config x y :> Papget.renderer) + | _ -> failwith (sprintf "Unexpected papget display: %s" display) in + let block_name = Papget.get_property "block_name" papget in + let clicked = fun () -> + prerr_endline "Warning: goto_block papget sends to all A/C"; + Hashtbl.iter + (fun ac_id ac -> + let blocks = ExtXml.child ac.Live.fp "blocks" in + let block = ExtXml.child ~select:(fun x -> ExtXml.attrib x "name" = block_name) blocks "block" in + let block_id = ExtXml.int_attrib block "no" in + Live.jump_to_block ac_id block_id + ) + Live.aircrafts + in + let properties = [ Papget.property "block_name" block_name ] in + + let p = new Papget.canvas_goto_block_item properties clicked renderer in + let p = (p :> Papget.item) in + register_papget p p + | "variable_setting" -> + let renderer = + match display with + "button" -> + (new Papget.canvas_button geomap#still ~config x y :> Papget.renderer) + | _ -> failwith (sprintf "Unexpected papget display: %s" display) in + + let varname = Papget.get_property "variable" papget + and value = float_of_string (Papget.get_property "value" papget) in + + let clicked = fun () -> + prerr_endline "Warning: variable_setting papget sending to all active A/C"; + Hashtbl.iter + (fun ac_id ac -> + match ac.Live.dl_settings_page with + None -> () + | Some settings -> + let var_id = settings#assoc varname in + Live.dl_setting ac_id var_id value) + Live.aircrafts + in + let properties = [ Papget.property "variable" varname; + Papget.float_property "value" value ] in + let p = new Papget.canvas_variable_setting_item properties clicked renderer in + let p = (p :> Papget.item) in + register_papget p p + | _ -> failwith (sprintf "Unexpected papget type: %s" type_) (* Drag and drop handler for papgets *) -let dnd_targets = [ { Gtk.target = "STRING"; flags = []; info = 0} ] +let dnd_targets = [ { Gtk.target = "STRING"; flags = []; info = 0 } ] let parse_dnd = let sep = Str.regexp ":" in fun s -> @@ -525,8 +607,9 @@ let listen_dropped_papgets = fun (geomap:G.widget) -> let sender = if sender = "*" then None else Some sender in let msg_listener = new Papget.message ~class_name ?sender msg_name in let renderer = new Papget.canvas_text geomap#still (float x) (float y) in - let _ = new Papget.canvas_display_item msg_listener field_name (renderer:> Papget.renderer) in - () + let p = new Papget.canvas_display_item msg_listener field_name (renderer:> Papget.renderer) in + let p = (p :> Papget.item) in + register_papget p p with exc -> prerr_endline (Printexc.to_string exc) in @@ -535,6 +618,26 @@ let listen_dropped_papgets = fun (geomap:G.widget) -> +let save_layout = fun filename contents -> + let dir = Filename.dirname filename in + let dialog = GWindow.file_chooser_dialog ~action:`SAVE ~title:"Save Layout" () in + ignore (dialog#set_current_folder dir); + dialog#add_filter (GFile.filter ~name:"xml" ~patterns:["*.xml"] ()); + dialog#add_button_stock `CANCEL `CANCEL ; + dialog#add_select_button_stock `SAVE `SAVE ; + let _ = dialog#set_current_name (Filename.basename filename) in + begin match dialog#run (), dialog#filename with + `SAVE, Some name -> + dialog#destroy (); + let f = open_out name in + fprintf f "%s\n" contents; + close_out f + | _ -> dialog#destroy () + end + + + + (************************** MAIN ********************************************) let () = let file_to_edit = ref "" in @@ -614,9 +717,17 @@ let () = pack_widgets `HORIZONTAL the_layout widgets window#add; (** packing mapgets *) - let papgets = find_widget_children "map2d" the_layout in + let papgets = try find_widget_children "map2d" the_layout with Not_found -> [] in List.iter (pack_papget geomap) papgets; listen_dropped_papgets geomap; + let save_layout = fun () -> + let the_new_layout = replace_widget_children "map2d" (papgets_config ()) the_layout in + let width, height = Gdk.Drawable.get_size window#misc#window in + let new_layout = Xml.Element ("layout", ["width", soi width; "height", soi height], [the_new_layout]) in + save_layout layout_file (Xml.to_string_fmt new_layout) + in + ignore (menu_fact#add_item "Save layout" ~key:GdkKeysyms._S ~callback:save_layout); + if !mplayer <> "" then plugin_window := sprintf "mplayer -nomouseinput %s -wid " !mplayer; diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index 15ad649db0..02111e7f97 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/sw/ground_segment/cockpit/live.ml @@ -204,6 +204,10 @@ let jump_to_block = fun ac_id id -> Ground_Pprz.message_send "gcs" "JUMP_TO_BLOCK" ["ac_id", Pprz.String ac_id; "block_id", Pprz.Int id] +let dl_setting = fun ac_id idx value -> + let vs = ["ac_id", Pprz.String ac_id; "index", Pprz.Int idx;"value", Pprz.Float value] in + Ground_Pprz.message_send "dl" "DL_SETTING" vs + let menu_entry_of_block = fun ac_id (id, name) -> let send_msg = fun () -> jump_to_block ac_id id in `I (name, send_msg) @@ -476,9 +480,8 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id prerr_endline (Printexc.to_string exc); Xml.Element("empty", [], []) in - let dl_setting_callback = fun idx value -> - let vs = ["ac_id", Pprz.String ac_id; "index", Pprz.Int idx;"value", Pprz.Float value] in - Ground_Pprz.message_send "dl" "DL_SETTING" vs in + let dl_setting_callback = fun idx value -> + dl_setting ac_id idx value in let dl_settings_page = try let xml_settings = Xml.children (ExtXml.child settings_xml "dl_settings") in diff --git a/sw/ground_segment/cockpit/live.mli b/sw/ground_segment/cockpit/live.mli index e6702b10ad..f511c2be65 100644 --- a/sw/ground_segment/cockpit/live.mli +++ b/sw/ground_segment/cockpit/live.mli @@ -26,7 +26,7 @@ type color = string -type aircraft = { +type aircraft = private { ac_name : string; config : Pprz.values; track : MapTrack.track; @@ -72,3 +72,10 @@ val track_size : int ref val listen_acs_and_msgs : MapCanvas.widget -> GPack.notebook -> Pages.alert -> bool -> GMisc.drawing_area -> unit (** [listen_acs_and_msgs geomap aircraft_notebook alert_page auto_center_new_ac] *) + +val jump_to_block : string -> int -> unit +(** [jump_to_block ac_id block_id] Sends a JUMP_TO_BLOCK message *) + +val dl_setting : string -> int -> float -> unit +(** [dl_setting ac_id var_index value] Sends a DL_SETTING message *) + diff --git a/sw/lib/ocaml/papget.ml b/sw/lib/ocaml/papget.ml index 2ebf5541d1..aa33ae9d19 100644 --- a/sw/lib/ocaml/papget.ml +++ b/sw/lib/ocaml/papget.ml @@ -8,10 +8,17 @@ let affine_pos xw yw = affine_pos_and_angle xw yw 0. let (//) = Filename.concat + +class type item = object + method config : unit -> Xml.xml + method deleted : bool +end + class message = fun ?sender ?(class_name="telemetry") msg_name -> object val mutable callbacks = [] method connect = fun f cb -> callbacks <- (f, cb) :: callbacks + method msg_name = msg_name initializer let module P = Pprz.Messages (struct let name = class_name end) in let cb = fun _sender values -> @@ -45,19 +52,38 @@ class type renderer = method edit : (GObj.widget -> unit) -> unit method item : movable_item method update : string -> unit + method config : unit -> Xml.xml list end +let get_property = fun attr_name xml -> + let attr = ExtXml.child ~select:(fun x -> ExtXml.attrib x "name" = attr_name) xml "property" in + ExtXml.attrib attr "value" -class canvas_text = fun canvas_group x y -> + +let get_prop = fun name children default -> + let xml = Xml.Element ("", [], children) in + try get_property name xml with _ -> default + +let property = fun name value -> + Xml.Element("property", [ "name", name; "value", value ], []) + +let float_property = fun name value -> + property name (string_of_float value) + +class canvas_text = fun ?(config=[]) canvas_group x y -> let group = GnoCanvas.group ~x ~y canvas_group in let text = GnoCanvas.text group in object (self) - val mutable format = "%.2f" - val mutable size = 15. - val mutable color = "green" + val mutable format = get_prop "format" config "%.2f" + val mutable size = float_of_string (get_prop "size" config "15.") + val mutable color = get_prop "color" config "green" method tag = "Text" method item = (group :> movable_item) + method config = fun () -> + [ property "format" format; + float_property "size" size; + property "color" color ] method set_format = fun f -> format <- f method set_size = fun f -> size <- f method set_color = fun f -> color <- f @@ -85,36 +111,43 @@ class canvas_text = fun canvas_group x y -> end -(********************************* Ruler *************************************) -class canvas_ruler = fun ?(index_on_right=false) ?(text_props=[`ANCHOR `CENTER; `FILL_COLOR "white"]) ?(max=1000) ?(scale=2.) ?(w=32.) ?(index_width=10.) ?(step=10) ?(h=100.) canvas_group x y -> +(***************************Vertical Ruler ***********************************) +class canvas_ruler = fun ?(config=[]) canvas_group x y -> + + let h = float_of_string (get_prop "height" config "100.") + and index_on_right = bool_of_string (get_prop "index_on_right" config "false") + and scale = float_of_string (get_prop "scale" config "2.") + and w = float_of_string (get_prop "width" config "32.") + and step = int_of_string (get_prop "step" config "10") in + let text_props=[`ANCHOR `CENTER; `FILL_COLOR "white"] + and index_width = 10. in + let root = GnoCanvas.group ~x ~y canvas_group in let r = GnoCanvas.group root in - let height = scale *. float max in - (* Grey background *) - let _ = GnoCanvas.rect ~x1:0. ~y1:(-.height) ~x2:w ~y2:height ~fill_color:"#808080" r in let props = (text_props@[`ANCHOR `EAST]) in (* One step drawer *) - let tab = Array.create (max/step) false in - let draw = fun i -> + let draw = fun i value -> let i = i * step in - let y = -. scale *. float i in - let text = Printf.sprintf "%d" i in - let _ = GnoCanvas.text ~text ~props ~y ~x:(w*.0.75) r in - let _ = GnoCanvas.line ~points:[|w*.0.8;y;w-.1.;y|] ~fill_color:"white" r in + let y = -. scale *. (float i -. value) in + if y >= -. h && y <= h then begin + let text = Printf.sprintf "%d" i in + ignore (GnoCanvas.text ~text ~props ~y ~x:(w*.0.75) r); + ignore(GnoCanvas.line ~points:[|w*.0.8;y;w-.1.;y|] ~fill_color:"white" r) + end; let y = y -. float step /. 2. *. scale in - let _ = GnoCanvas.line ~points:[|w*.0.8;y;w-.1.;y|] ~fill_color:"white" r in - () in + if y >= -. h && y <= h then + ignore(GnoCanvas.line ~points:[|w*.0.8;y;w-.1.;y|] ~fill_color:"white" r) + in - let lazy_drawer = fun v -> - let v = truncate v / step in + let drawer = fun value -> + (* Remove previous items *) + List.iter (fun i -> i#destroy ()) r#get_items; + let v = truncate value / step in let k = truncate (h /. scale) / step in - for i = Pervasives.max 0 (v - k) to min (v + k) (Array.length tab - 1) do (* FIXME *) - if not tab.(i) then begin - tab.(i) <- true; - draw i - end + for i = Pervasives.max 0 (v - k) to (v + k) do + draw i value done in (** Yellow index *) @@ -125,34 +158,57 @@ class canvas_ruler = fun ?(index_on_right=false) ?(text_props=[`ANCHOR `CENTER; if index_on_right then idx#affine_absolute (affine_pos_and_angle w 0. Latlong.pi) in - (** Mask (bottom & top) *) - let _ = GnoCanvas.rect ~x1:0. ~y1:(-.height) ~x2:w ~y2:(-.h) ~fill_color:"black" root in - let _ = GnoCanvas.rect ~x1:0. ~y1:height ~x2:w ~y2:h ~fill_color:"black" root in - object method tag = "Ruler" method edit = fun (pack:GObj.widget -> unit) -> () method update = fun value -> let value = float_of_string value in - r#affine_absolute (affine_pos 0. 0.); - lazy_drawer value; - r#affine_absolute (affine_pos 0. (scale*.value)); + drawer value method item = (root :> movable_item) + method config = fun () -> config (* Not editable *) + end + +(****************************************************************************) +class canvas_button = fun ?(config=[]) canvas_group x y -> + let icon = get_prop "icon" config "icon_file" in + let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in + let group = GnoCanvas.group ~x ~y canvas_group in + let _item = GnoCanvas.pixbuf ~pixbuf group in + object + method tag = "Button" + method item = (group :> movable_item) + method edit = fun (pack:GObj.widget -> unit) -> () + method update = fun (value:string) -> () + method config = fun () -> + [ property "icon" icon] + end + + +(****************************************************************************) +class widget_renderer = fun (tag:string) widget ?(config=[]) canvas_group x y -> + let group = GnoCanvas.group ~x ~y canvas_group in + let item = GnoCanvas.widget ~width:50. ~height:50. ~widget group in + object + method tag = tag + method edit = fun (_:GObj.widget->unit) -> () + method item = (item :> movable_item) + method update = fun (_:string) -> () + method config = fun () -> (config : Xml.xml list) end let renderers = - [ (new canvas_text :> #GnoCanvas.group -> float -> float -> renderer); - new canvas_ruler ] + [ (new canvas_text :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> renderer); + (new canvas_ruler :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> renderer) ] let lazy_tagged_renderers = lazy - (let x = 0. and y = 0. - and group = (GnoCanvas.canvas ())#root in - List.map - (fun constructor -> - let o = constructor group x y in - (o#tag, constructor)) - renderers) + (let x = 0. and y = 0. + and group = (GnoCanvas.canvas ())#root in + List.map + (fun constructor -> + let o = constructor ?config:None group x y in + (o#tag, constructor)) + renderers) class canvas_item = fun canvas_renderer -> @@ -162,6 +218,15 @@ class canvas_item = fun canvas_renderer -> val mutable renderer = canvas_renderer val mutable x_press = 0. val mutable y_press = 0. + val mutable deleted = false + + method renderer = renderer + + method xy = + let (x0, y0) = renderer#item#i2w 0. 0. in + renderer#item#parent#w2i x0 y0 + + method deleted = deleted method update = fun value -> (renderer#update:string->unit) value @@ -192,7 +257,8 @@ class canvas_item = fun canvas_renderer -> let x = GdkEvent.Motion.x ev and y = GdkEvent.Motion.y ev in let (xw, yw) = renderer#item#parent#w2i x y in - item#set [`X (xw-.x_press); `Y (yw-.y_press)] + item#set [`X (xw-.x_press); `Y (yw-.y_press)]; + renderer#item#parent#affine_relative [|1.;0.;0.;1.;0.;0.|] end; true | `BUTTON_RELEASE ev -> @@ -214,6 +280,13 @@ class canvas_item = fun canvas_renderer -> let strings = List.map fst tagged_renderers in let (combo, (tree, column)) = GEdit.combo_box_text ~packing:dialog#box_item_chooser#add ~strings () in + tree#foreach + (fun _path row -> + if tree#get ~row ~column = renderer#tag then begin + combo#set_active_iter (Some row); + true + end else + false); let connect_item_editor = fun () -> begin (* Remove the current child ? *) @@ -245,6 +318,11 @@ class canvas_item = fun canvas_renderer -> connect_item_editor ())); (* Connect the buttons *) + ignore (dialog#button_delete#connect#clicked + (fun () -> + dialog#papget_editor#destroy (); + renderer#item#destroy (); + deleted <- true)); ignore (dialog#button_ok#connect#clicked (fun () -> dialog#papget_editor#destroy ())) val mutable connection = @@ -257,26 +335,27 @@ class canvas_item = fun canvas_renderer -> self#connect () end - class canvas_display_item = fun msg_obj field_name canvas_renderer -> object inherit field msg_obj field_name as super inherit canvas_item canvas_renderer as item method update_field = fun value -> - super#update_field value; - item#update value + if not deleted then begin + super#update_field value; + item#update value + end - end - - -(****************************************************************************) -class canvas_button = fun icon_file -> - let button = GButton.button () in - let pixbuf = GdkPixbuf.from_file icon_file in - let _ = GMisc.image ~pixbuf ~packing:button#add () in - object - method update = fun (value:float) -> () + method config = fun () -> + let props = renderer#config () in + let field = sprintf "%s:%s" msg_obj#msg_name field_name in + let prop = property "field" field in + let (x, y) = item#xy in + let attrs = + [ "type", "message_field"; + "display", String.lowercase item#renderer#tag; + "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in + Xml.Element ("papget", attrs, prop::props) end @@ -293,4 +372,31 @@ class canvas_setting_item = fun variable canvas_renderer -> end +(****************************************************************************) +(** A clickable item is not editable: The #edit method is overiden with a + provided callback *) +class canvas_clickable_item = fun type_ properties callback canvas_renderer -> + object + inherit canvas_item canvas_renderer as item + method edit = fun () -> callback () + method config = fun () -> + let props = renderer#config () in + let (x, y) = item#xy in + let attrs = + [ "type", type_; + "display", String.lowercase item#renderer#tag; + "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in + Xml.Element ("papget", attrs, properties@props) + end + + +class canvas_goto_block_item = fun properties callback canvas_renderer -> + object + inherit canvas_clickable_item "goto_block" properties callback canvas_renderer as item + end + +class canvas_variable_setting_item = fun properties callback canvas_renderer -> + object + inherit canvas_clickable_item "variable_setting" properties callback canvas_renderer + end diff --git a/sw/lib/ocaml/widgets.glade b/sw/lib/ocaml/widgets.glade index eaafcc989f..5a25fedba5 100644 --- a/sw/lib/ocaml/widgets.glade +++ b/sw/lib/ocaml/widgets.glade @@ -134,7 +134,7 @@ Papget Editor GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE - False + True True False True @@ -211,7 +211,7 @@ True True - gtk-ok + gtk-close True GTK_RELIEF_NORMAL True