diff --git a/sw/ground_segment/cockpit/page_settings.ml b/sw/ground_segment/cockpit/page_settings.ml index d4817d43dd..ace96e1217 100644 --- a/sw/ground_segment/cockpit/page_settings.ml +++ b/sw/ground_segment/cockpit/page_settings.ml @@ -30,26 +30,26 @@ let (//) = Filename.concat class setting = fun (i:int) (xml:Xml.xml) (current_value:GMisc.label) set_default -> - object - method index = i - method xml = xml - method current_value = - let auc = Pprz.alt_unit_coef_of_xml xml in - let (alt_a, alt_b) = Ocaml_tools.affine_transform auc in - (float_of_string current_value#text -. alt_b) /. alt_a - method update = fun s -> - if current_value#text <> s then begin - current_value#set_text s; - try set_default (float_of_string s) with Failure "float_of_string" -> () - end - end +object + method index = i + method xml = xml + method current_value = + let auc = Pprz.alt_unit_coef_of_xml xml in + let (alt_a, alt_b) = Ocaml_tools.affine_transform auc in + (float_of_string current_value#text -. alt_b) /. alt_a + method update = fun s -> + if current_value#text <> s then begin + current_value#set_text s; + try set_default (float_of_string s) with Failure "float_of_string" -> () + end +end let pipe_regexp = Str.regexp "|" let values_of_dl_setting = fun dl_setting -> try Array.of_list (Str.split pipe_regexp (Xml.attrib dl_setting "values")) with - _ -> [||] + _ -> [||] (* Look for the index of a value in a array. May raise Not_found *) @@ -101,39 +101,39 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin let value = ref lower in let callback = fun () -> do_change i !value in let update_value = fun index -> - modified := true; - value := float index; - if auto_but#active then callback () in + modified := true; + value := float index; + if auto_but#active then callback () in if Array.length values > 2 then (* Combo box *) - let strings = Array.to_list values in - let combo = Gtk_tools.combo strings hbox in + let strings = Array.to_list values in + let combo = Gtk_tools.combo strings hbox in - let update_string = fun string -> - try - update_value ((search_index string values) + truncate lower) - with - Not_found -> failwith (sprintf "Internal error: Settings, %s not found" string) in - Gtk_tools.combo_connect combo update_string; + let update_string = fun string -> + try + update_value ((search_index string values) + truncate lower) + with + Not_found -> failwith (sprintf "Internal error: Settings, %s not found" string) in + Gtk_tools.combo_connect combo update_string; - (callback, fun j -> try Gtk_tools.select_in_combo combo values.(truncate j) with _ -> ()) + (callback, fun j -> try Gtk_tools.select_in_combo combo values.(truncate j) with _ -> ()) else (* radio buttons *) - let ilower = truncate lower - and iupper = truncate upper in - let callback = fun _ -> do_change i !value in - let group = (GButton.radio_button ())#group in (* Group shared by the buttons *) - let buttons = Array.init (iupper-ilower+1) - (fun j -> - (* Build the button *) - let label = - if Array.length values = 0 - then Printf.sprintf "%d" (ilower + j) - else values.(j) in - let b = GButton.radio_button ~group ~label ~packing:hbox#add () in + let ilower = truncate lower + and iupper = truncate upper in + let callback = fun _ -> do_change i !value in + let group = (GButton.radio_button ())#group in (* Group shared by the buttons *) + let buttons = Array.init (iupper-ilower+1) + (fun j -> + (* Build the button *) + let label = + if Array.length values = 0 + then Printf.sprintf "%d" (ilower + j) + else values.(j) in + let b = GButton.radio_button ~group ~label ~packing:hbox#add () in - (* Connect the event *) - ignore (b#connect#pressed (fun () -> update_value (ilower + j))); - b) in - (callback, fun j -> try buttons.(truncate j - ilower)#set_active true with _ -> ()) + (* Connect the event *) + ignore (b#connect#pressed (fun () -> update_value (ilower + j))); + b) in + (callback, fun j -> try buttons.(truncate j - ilower)#set_active true with _ -> ()) else (* slider *) let value = (lower +. upper) /. 2. in let adj = GData.adjustment ~value ~lower ~upper:(upper+.step_incr) ~step_incr ~page_incr ~page_size () in @@ -173,49 +173,49 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin let _icon = GMisc.image ~stock:`UNDO ~packing:undo_but#add () in let callback = fun _ -> match !prev_value with - None -> () - | Some v -> do_change i v in + None -> () + | Some v -> do_change i v in ignore (undo_but#connect#clicked ~callback); tooltips#set_tip undo_but#coerce ~text:"Undo"; ignore (auto_but#connect#toggled - (fun () -> - commit_but#misc#set_sensitive (not auto_but#active); - undo_but#misc#set_sensitive (not auto_but#active))); + (fun () -> + commit_but#misc#set_sensitive (not auto_but#active); + undo_but#misc#set_sensitive (not auto_but#active))); (** Insert the related buttons in the strip and prepare the papgets DnD *) List.iter (fun x -> match String.lowercase (Xml.tag x) with - "strip_button" -> - let label = ExtXml.attrib x "name" - and sp_value = ExtXml.float_attrib x "value" - and group = ExtXml.attrib_or_default x "group" "" in - let b = - try (* Is it an icon ? *) - let icon = Xml.attrib x "icon" in - let b = GButton.button () in - let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in - ignore (GMisc.image ~pixbuf ~packing:b#add ()); + "strip_button" -> + let label = ExtXml.attrib x "name" + and sp_value = ExtXml.float_attrib x "value" + and group = ExtXml.attrib_or_default x "group" "" in + let b = + try (* Is it an icon ? *) + let icon = Xml.attrib x "icon" in + let b = GButton.button () in + let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in + ignore (GMisc.image ~pixbuf ~packing:b#add ()); - (* Drag for Drop *) - let papget = Papget_common.xml "variable_setting" "button" - ["variable", varname; - "value", ExtXml.attrib x "value"; - "icon", icon] in - Papget_common.dnd_source b#coerce papget; + (* Drag for Drop *) + let papget = Papget_common.xml "variable_setting" "button" + ["variable", varname; + "value", ExtXml.attrib x "value"; + "icon", icon] in + Papget_common.dnd_source b#coerce papget; (* Associates the label as a tooltip *) - tooltips#set_tip b#coerce ~text:label; - b - with - Xml.No_attribute "icon" -> GButton.button ~label () - | exc -> - prerr_endline (Printexc.to_string exc); - GButton.button ~label () in - (strip group b#coerce: unit); - ignore (b#connect#clicked (fun _ -> do_change i sp_value)) - | "key_press" -> add_key x (do_change i) keys - | t -> failwith (sprintf "Page_settings.one_setting, Unexpected tag: '%s'" t)) + tooltips#set_tip b#coerce ~text:label; + b + with + Xml.No_attribute "icon" -> GButton.button ~label () + | exc -> + prerr_endline (Printexc.to_string exc); + GButton.button ~label () in + (strip group b#coerce: unit); + ignore (b#connect#clicked (fun _ -> do_change i sp_value)) + | "key_press" -> add_key x (do_change i) keys + | t -> failwith (sprintf "Page_settings.one_setting, Unexpected tag: '%s'" t)) (Xml.children dl_setting); new setting i dl_setting current_value set_default @@ -223,38 +223,38 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin let same_tag_for_all = function - [] -> failwith "Page_settings: unreachable, empty dl_settings element" +[] -> failwith "Page_settings: unreachable, empty dl_settings element" | x::xs -> - let tag_first = Xml.tag x in - List.iter (fun y -> assert(ExtXml.tag_is y tag_first)) xs; - String.lowercase tag_first + let tag_first = Xml.tag x in + List.iter (fun y -> assert(ExtXml.tag_is y tag_first)) xs; + String.lowercase tag_first (** Build the tree of settings *) let rec build_settings = fun do_change i flat_list keys xml_settings packing tooltips strip -> match same_tag_for_all xml_settings with - "dl_setting" -> - List.iter - (fun dl_setting -> - let label_value = one_setting !i do_change packing dl_setting tooltips strip keys in - flat_list := label_value :: !flat_list; - incr i) - xml_settings - | "dl_settings" -> + "dl_setting" -> + List.iter + (fun dl_setting -> + let label_value = one_setting !i do_change packing dl_setting tooltips strip keys in + flat_list := label_value :: !flat_list; + incr i) + xml_settings + | "dl_settings" -> let n = GPack.notebook ~packing () in List.iter (fun dl_settings -> - let text = ExtXml.attrib dl_settings "name" in - let _sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in - let vbox = GPack.vbox () in + let text = ExtXml.attrib dl_settings "name" in + let _sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in + let vbox = GPack.vbox () in - let tab_label = (GMisc.label ~text ())#coerce in - ignore (n#append_page ~tab_label vbox#coerce); + let tab_label = (GMisc.label ~text ())#coerce in + ignore (n#append_page ~tab_label vbox#coerce); - let children = Xml.children dl_settings in - build_settings do_change i flat_list keys children vbox#pack tooltips strip) - xml_settings - | tag -> failwith (sprintf "Page_settings.build_settings, unexpected tag '%s'" tag) + let children = Xml.children dl_settings in + build_settings do_change i flat_list keys children vbox#pack tooltips strip) + xml_settings + | tag -> failwith (sprintf "Page_settings.build_settings, unexpected tag '%s'" tag) class settings = fun ?(visible = fun _ -> true) xml_settings do_change strip -> @@ -269,31 +269,30 @@ class settings = fun ?(visible = fun _ -> true) xml_settings do_change strip -> let length = Array.length variables in let assocs = List.map (fun setting -> (ExtXml.attrib setting#xml "var", setting#index)) ordered_list in - object (self) - method widget = sw#coerce - method length = length - method keys = !keys - method set = fun i v -> - if visible self#widget then - let setting = variables.(i) in - let auc = Pprz.alt_unit_coef_of_xml setting#xml in - let (alt_a, alt_b) = Ocaml_tools.affine_transform auc in - let v = alt_a *. v +. alt_b in - let s = string_of_float v in - if i < 0 || i >= Array.length variables then - failwith (sprintf "Pages.settings#set: %d out of bounnds (length=%d)" i (Array.length variables)); - let s = - let values = values_of_dl_setting setting#xml in - try - let lower = int_of_string (ExtXml.attrib setting#xml "min") in - values.(truncate v - lower) - with - _ -> s in - setting#update s - method assoc var = List.assoc var assocs - method save = fun airframe_filename -> - let settings = Array.fold_right (fun setting r -> try (setting#index, setting#xml, setting#current_value)::r with _ -> r) variables [] in - SaveSettings.popup airframe_filename (Array.of_list settings) do_change - end - +object (self) + method widget = sw#coerce + method length = length + method keys = !keys + method set = fun i v -> + if visible self#widget then + let setting = variables.(i) in + let auc = Pprz.alt_unit_coef_of_xml setting#xml in + let (alt_a, alt_b) = Ocaml_tools.affine_transform auc in + let v = alt_a *. v +. alt_b in + let s = string_of_float v in + if i < 0 || i >= Array.length variables then + failwith (sprintf "Pages.settings#set: %d out of bounnds (length=%d)" i (Array.length variables)); + let s = + let values = values_of_dl_setting setting#xml in + try + let lower = int_of_string (ExtXml.attrib setting#xml "min") in + values.(truncate v - lower) + with + _ -> s in + setting#update s + method assoc var = List.assoc var assocs + method save = fun airframe_filename -> + let settings = Array.fold_right (fun setting r -> try (setting#index, setting#xml, setting#current_value)::r with _ -> r) variables [] in + SaveSettings.popup airframe_filename (Array.of_list settings) do_change +end diff --git a/sw/ground_segment/cockpit/saveSettings.ml b/sw/ground_segment/cockpit/saveSettings.ml index 91138dc714..65efc72b25 100644 --- a/sw/ground_segment/cockpit/saveSettings.ml +++ b/sw/ground_segment/cockpit/saveSettings.ml @@ -46,18 +46,18 @@ let floats_not_equal = fun f1 f2 -> (* Unit conversions *) let scale_of_units = fun u1 u2 -> match u1, u2 with - "deg", "rad" -> 180. /. Latlong.pi - | "rad", "deg" -> Latlong.pi /. 180. - | u1, u2 when u1 = u2 -> 1. - | _ -> invalid_arg (Printf.sprintf "SaveSettings.scale_of_units %s %s" u1 u2) + "deg", "rad" -> 180. /. Latlong.pi + | "rad", "deg" -> Latlong.pi /. 180. + | u1, u2 when u1 = u2 -> 1. + | _ -> invalid_arg (Printf.sprintf "SaveSettings.scale_of_units %s %s" u1 u2) (** The save file dialog box *) let save_airframe = fun w filename save -> match GToolbox.select_file ~title:"Save Airframe" ~filename () with - None -> () - | Some file -> + None -> () + | Some file -> save file; w#save_settings#destroy () @@ -77,7 +77,7 @@ let display_columns = fun w model -> let renderer = GTree.cell_renderer_text [`XALIGN 0.] in let vc = GTree.view_column ~title ~renderer:(renderer, ["text", col]) () in vc#set_clickable true; - ignore (w#treeview_settings#append_column vc)) + ignore (w#treeview_settings#append_column vc)) text_columns; let renderer = GTree.cell_renderer_toggle [`XALIGN 0.] in let vc = GTree.view_column ~renderer:(renderer, ["active", col_to_save]) () in @@ -117,13 +117,13 @@ let write_xml = fun (model:GTree.tree_store) old_file airframe_xml file -> let send_airframe_values = fun (model:GTree.tree_store) send_value -> - model#foreach (fun _path row -> - if model#get ~row ~column:col_to_save then begin - let index = model#get ~row ~column:col_index - and airframe_value = model#get ~row ~column:col_airframe_value in - send_value index airframe_value - end; - false) + model#foreach (fun _path row -> + if model#get ~row ~column:col_to_save then begin + let index = model#get ~row ~column:col_index + and airframe_value = model#get ~row ~column:col_airframe_value in + send_value index airframe_value + end; + false) @@ -157,9 +157,9 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml -> model#set ~row ~column:col_settings_scaled_value (value /. scale); model#set ~row ~column:col_to_save (floats_not_equal scaled_value value) with - Xml.No_attribute _ -> () - | EditAirframe.No_param param -> - not_in_airframe_file := param :: !not_in_airframe_file ) (* Not savable *) + Xml.No_attribute _ -> () + | EditAirframe.No_param param -> + not_in_airframe_file := param :: !not_in_airframe_file ) (* Not savable *) settings; (* Warning if needed *)