diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index 7787fa11aa..540a5500a0 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/sw/ground_segment/cockpit/live.ml @@ -102,7 +102,7 @@ type aircraft = { mutable ground_prox : bool; mutable got_track_status_timer : int; mutable last_dist_to_wp : float; - mutable dl_values : float array; + mutable dl_values : string option array; mutable last_unix_time : float; mutable airspeed : float } @@ -739,8 +739,8 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id let id = settings_tab#assoc "snav_desired_tow" in let set_appointment = fun _ -> begin try - let v = ac.dl_values.(id) in - let t = Unix.gmtime (Latlong.unix_time_of_tow (truncate v)) in + let v = match ac.dl_values.(id) with None -> raise Not_found | Some x -> int_of_string x in + let t = Unix.gmtime (Latlong.unix_time_of_tow v) in ac.strip#set_label "apt" (sprintf "%d:%02d:%02d" t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec) with _ -> () end; true @@ -910,10 +910,13 @@ let listen_dl_value = fun () -> match ac.dl_settings_page with Some settings -> let csv = Pprz.string_assoc "values" vs in - let values = Array.map float_of_string (Array.of_list (Str.split list_separator csv)) in + let string_value = fun v -> match v with "?" -> None | _ -> Some v in + let values = Array.map string_value (Array.of_list (Str.split list_separator csv)) in ac.dl_values <- values; for i = 0 to min (Array.length values) settings#length - 1 do - settings#set i (try values.(i) with _ -> failwith (sprintf "values.(%d)" i)) + try + settings#set i values.(i) + with _ -> () done | None -> () in safe_bind "DL_VALUES" get_dl_value diff --git a/sw/ground_segment/cockpit/live.mli b/sw/ground_segment/cockpit/live.mli index 53ed41711e..4222af0202 100644 --- a/sw/ground_segment/cockpit/live.mli +++ b/sw/ground_segment/cockpit/live.mli @@ -59,7 +59,7 @@ type aircraft = private { mutable ground_prox : bool; mutable got_track_status_timer : int; mutable last_dist_to_wp : float; - mutable dl_values : float array; + mutable dl_values : string option array; mutable last_unix_time : float; mutable airspeed : float } diff --git a/sw/ground_segment/cockpit/page_settings.ml b/sw/ground_segment/cockpit/page_settings.ml index 4080915016..0dd1b0ef3f 100644 --- a/sw/ground_segment/cockpit/page_settings.ml +++ b/sw/ground_segment/cockpit/page_settings.ml @@ -31,15 +31,26 @@ class setting = fun (i:int) (xml:Xml.xml) (current_value:GMisc.label) set_defaul object method index = i method xml = xml + val mutable last_known_value = None + method last_known_value = + match last_known_value with None -> raise Not_found | Some v -> v 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 + (* if not yet confirmed, display "?" *) + if s = "?" then + current_value#set_text "?" + else + if current_value#text <> s then begin + current_value#set_text s; + try + let v = float_of_string s in + last_known_value <- Some v; + set_default v + with Failure "float_of_string" -> () + end end let pipe_regexp = Str.regexp "|" @@ -183,9 +194,11 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin let set_default = fun x -> if not !modified then set_default x else () in - (* Update value *) + (* click current_value lable to request an update *) let callback = fun _ -> - do_change i infinity; true in + do_change i infinity; + current_value#set_text "?"; + true in ignore (eb#event#connect#button_press ~callback); (* Auto check button *) @@ -199,10 +212,12 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin let _icon = GMisc.image ~stock:`APPLY ~packing:commit_but#add () in let callback = fun x -> prev_value := (try Some ((float_of_string current_value#text-.alt_b)/.alt_a) with _ -> None); - commit x + commit x; + current_value#set_text "?" in ignore (commit_but#connect#clicked ~callback); tooltips#set_tip commit_but#coerce ~text:"Commit"; + tooltips#set_tip current_value#coerce ~text:"Current value, click to request update."; (* Undo button *) let undo_but = GButton.button ~packing:hbox#pack () in @@ -309,26 +324,31 @@ object (self) method widget = sw#coerce method length = length method keys = !keys - method set = fun i v -> + method set = fun i value -> 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 + let s, v = match value with + | None -> "?", -1 + | Some x -> + let v = try float_of_string x with _ -> failwith (sprintf "Pages.settings#set:wrong values.(%d) = %s" i x) 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 + string_of_float v, truncate 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) + values.(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 + let settings = Array.fold_right (fun setting r -> try (setting#index, setting#xml, setting#last_known_value)::r with _ -> r) variables [] in SaveSettings.popup airframe_filename (Array.of_list settings) do_change end diff --git a/sw/ground_segment/cockpit/page_settings.mli b/sw/ground_segment/cockpit/page_settings.mli index 52691f6a67..73b1600ba5 100644 --- a/sw/ground_segment/cockpit/page_settings.mli +++ b/sw/ground_segment/cockpit/page_settings.mli @@ -26,7 +26,7 @@ class settings : ?visible:(GObj.widget -> bool) -> Xml.xml list -> (int -> float -> unit) -> (string -> GObj.widget -> unit) -> object method length : int (** Total number of settings *) - method set : int -> float -> unit (** Set the current value *) + method set : int -> string option -> unit (** Set the current value *) method assoc : string -> int method widget : GObj.widget method save : string -> unit diff --git a/sw/ground_segment/tmtc/aircraft.ml b/sw/ground_segment/tmtc/aircraft.ml index 2d854e2992..383478880d 100644 --- a/sw/ground_segment/tmtc/aircraft.ml +++ b/sw/ground_segment/tmtc/aircraft.ml @@ -184,7 +184,7 @@ type aircraft = { mutable stage_time : int; mutable block_time : int; mutable horiz_mode : horiz_mode; - dl_setting_values : float array; + dl_setting_values : float option array; mutable nb_dl_setting_values : int; mutable survey : (Latlong.geographic * Latlong.geographic) option; datalink_status : datalink_status; @@ -217,7 +217,7 @@ let new_aircraft = fun id name fp airframe -> cam = { phi = 0.; theta = 0. ; target=(0.,0.)}; fbw = { rc_status = "???"; rc_mode = "???"; rc_rate=0; pprz_mode_msgs_since_last_fbw_status_msg=0 }; svinfo = svsinfo_init; - dl_setting_values = Array.create max_nb_dl_setting_values 42.; + dl_setting_values = Array.create max_nb_dl_setting_values None; nb_dl_setting_values = 0; horiz_mode = UnknownHorizMode; horizontal_mode = 0; diff --git a/sw/ground_segment/tmtc/aircraft.mli b/sw/ground_segment/tmtc/aircraft.mli index bda45823c1..67a0a0890d 100644 --- a/sw/ground_segment/tmtc/aircraft.mli +++ b/sw/ground_segment/tmtc/aircraft.mli @@ -136,7 +136,7 @@ type aircraft = { mutable stage_time : int; mutable block_time : int; mutable horiz_mode : horiz_mode; - dl_setting_values : float array; + dl_setting_values : float option array; mutable nb_dl_setting_values : int; mutable survey : (Latlong.geographic * Latlong.geographic) option; datalink_status : datalink_status; diff --git a/sw/ground_segment/tmtc/fw_server.ml b/sw/ground_segment/tmtc/fw_server.ml index ac639a5b7e..756acea4bb 100644 --- a/sw/ground_segment/tmtc/fw_server.ml +++ b/sw/ground_segment/tmtc/fw_server.ml @@ -298,7 +298,7 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> | "DL_VALUE" -> let i = ivalue "index" in if i < max_nb_dl_setting_values then begin - a.dl_setting_values.(i) <- fvalue "value"; + a.dl_setting_values.(i) <- Some (fvalue "value"); a.nb_dl_setting_values <- max a.nb_dl_setting_values (i+1) end else failwith "Too much dl_setting values !!!" diff --git a/sw/ground_segment/tmtc/server.ml b/sw/ground_segment/tmtc/server.ml index a184cc612e..5cdd15f4cd 100644 --- a/sw/ground_segment/tmtc/server.ml +++ b/sw/ground_segment/tmtc/server.ml @@ -199,7 +199,9 @@ let send_dl_values = fun a -> if a.nb_dl_setting_values > 0 then let csv = ref "" in for i = 0 to a.nb_dl_setting_values - 1 do - csv := sprintf "%s%f," !csv a.dl_setting_values.(i) + match a.dl_setting_values.(i) with + | None -> csv := sprintf "%s?," !csv + | Some s -> csv := sprintf "%s%f," !csv s done; let vs = ["ac_id", Pprz.String a.id; "values", Pprz.String !csv] in Ground_Pprz.message_send my_id "DL_VALUES" vs @@ -677,7 +679,11 @@ let setting = fun logging _sender vs -> "ac_id", Pprz.String ac_id; "value", List.assoc "value" vs] in Dl_Pprz.message_send dl_id "SETTING" vs; - log logging ac_id "SETTING" vs + log logging ac_id "SETTING" vs; + (* mark the setting as not yet confirmed *) + let ac = Hashtbl.find aircrafts ac_id in + let idx = Pprz.int_of_value (List.assoc "index" vs) in + ac.dl_setting_values.(idx) <- None (** Got a GET_DL_SETTING, and send an GET_SETTING *) @@ -686,7 +692,11 @@ let get_setting = fun logging _sender vs -> let vs = [ "index", List.assoc "index" vs; "ac_id", Pprz.String ac_id ] in Dl_Pprz.message_send dl_id "GET_SETTING" vs; - log logging ac_id "GET_SETTING" vs + log logging ac_id "GET_SETTING" vs; + (* mark the setting as not yet confirmed *) + let ac = Hashtbl.find aircrafts ac_id in + let idx = Pprz.int_of_value (List.assoc "index" vs) in + ac.dl_setting_values.(idx) <- None (** Got a JUMP_TO_BLOCK, and send an BLOCK *) diff --git a/sw/ground_segment/tmtc/settings.ml b/sw/ground_segment/tmtc/settings.ml index e8ae766efd..0569ccc69c 100644 --- a/sw/ground_segment/tmtc/settings.ml +++ b/sw/ground_segment/tmtc/settings.ml @@ -59,7 +59,7 @@ let one_ac = fun (notebook:GPack.notebook) ac_name -> (* Bind to values updates *) let get_dl_value = fun _sender vs -> - settings#set (Pprz.int_assoc "index" vs) (Pprz.float_assoc "value" vs) + settings#set (Pprz.int_assoc "index" vs) (Some (string_of_float (Pprz.float_assoc "value" vs))) in ignore (Tele_Pprz.message_bind "DL_VALUE" get_dl_value);