diff --git a/sw/ground_segment/cockpit/papgets.ml b/sw/ground_segment/cockpit/papgets.ml index bace74fb2b..6fe6f5a643 100644 --- a/sw/ground_segment/cockpit/papgets.ml +++ b/sw/ground_segment/cockpit/papgets.ml @@ -25,9 +25,10 @@ *) open Printf +module PC = Papget_common let papgets = Hashtbl.create 5 -let register_papget = fun p p -> Hashtbl.add papgets p p +let register_papget = fun p -> Hashtbl.add papgets p p let dump_store = fun () -> Hashtbl.fold (fun _ p r -> @@ -49,6 +50,11 @@ let papget_listener = | _ -> failwith (sprintf "Unexpected field spec: %s" field) with _ -> failwith (sprintf "field attr expected in '%s" (Xml.to_string papget)) + +let locked = fun config -> + try + [PC.property "locked" (PC.get_property "locked" config)] + with _ -> [] let create = fun canvas_group papget -> let type_ = ExtXml.attrib papget "type" @@ -70,7 +76,7 @@ let create = fun canvas_group papget -> | _ -> failwith (sprintf "Unexpected papget display: %s" display) in let p = new Papget.canvas_display_float_item ~config msg_listener field_name renderer in let p = (p :> Papget.item) in - register_papget p p + register_papget p | "goto_block" -> let renderer = match display with @@ -89,11 +95,12 @@ let create = fun canvas_group papget -> ) Live.aircrafts in - let properties = [ Papget_common.property "block_name" block_name ] in + let properties = + [ Papget_common.property "block_name" block_name ] @ locked papget in let p = new Papget.canvas_goto_block_item properties clicked renderer in let p = (p :> Papget.item) in - register_papget p p + register_papget p | "variable_setting" -> let renderer = match display with @@ -115,11 +122,13 @@ let create = fun canvas_group papget -> Live.dl_setting ac_id var_id value) Live.aircrafts in - let properties = [ Papget_common.property "variable" varname; - Papget_common.float_property "value" value ] in + let properties = + [ Papget_common.property "variable" varname; + Papget_common.float_property "value" value ] + @ locked papget in let p = new Papget.canvas_variable_setting_item properties clicked renderer in let p = (p :> Papget.item) in - register_papget p p + register_papget p | _ -> failwith (sprintf "Unexpected papget type: %s" type_) @@ -132,9 +141,9 @@ let parse_message_dnd = match Str.split sep s with [s; c; m; f;scale] -> (s, c, m, f,scale) | _ -> raise (Parse_message_dnd (Printf.sprintf "parse_dnd: %s" s)) -let dnd_data_received = fun canvas_group context ~x ~y data ~info ~time -> +let dnd_data_received = fun canvas_group _context ~x ~y data ~info ~time -> try (* With the format sent by Messages *) - let (sender, class_name, msg_name, field_name,scale) = parse_message_dnd data#data in + let (_sender, _class_name, msg_name, field_name,scale) = parse_message_dnd data#data in let attrs = [ "type", "message_field"; "display", "text"; diff --git a/sw/lib/ocaml/papget.ml b/sw/lib/ocaml/papget.ml index 99876ee3e5..c3d781f8ed 100644 --- a/sw/lib/ocaml/papget.ml +++ b/sw/lib/ocaml/papget.ml @@ -72,7 +72,7 @@ class type canvas_item_type = end -class canvas_item = fun canvas_renderer -> +class canvas_item = fun ~config canvas_renderer -> let canvas_renderer = (canvas_renderer :> PR.t) in object (self) val mutable motion = false @@ -192,16 +192,17 @@ class canvas_item = fun canvas_renderer -> val mutable connection = canvas_renderer#item#connect#event (fun _ -> false) method connect = fun () -> - let item = (renderer#item :> PR.movable_item) in - connection <- item#connect#event self#event + if PC.get_prop "locked" config "false" = "false" then + let item = (renderer#item :> PR.movable_item) in + connection <- item#connect#event self#event initializer self#connect () end -class canvas_float_item = fun canvas_renderer -> +class canvas_float_item = fun ~config canvas_renderer -> object - inherit canvas_item canvas_renderer as super + inherit canvas_item ~config canvas_renderer as super val mutable affine = "1" @@ -228,10 +229,10 @@ class canvas_float_item = fun canvas_renderer -> class canvas_display_float_item = fun ~config (msg_obj:message) field_name (canvas_renderer:PR.t) -> object inherit field msg_obj field_name as super - inherit canvas_float_item canvas_renderer as item + inherit canvas_float_item ~config canvas_renderer as item initializer - affine <- PC.get_prop "scale" config "1" + affine <- PC.get_prop "pscale" config "1" method update_field = fun value -> if not deleted then begin @@ -254,9 +255,9 @@ class canvas_display_float_item = fun ~config (msg_obj:message) field_name (canv (****************************************************************************) -class canvas_setting_item = fun variable canvas_renderer -> +class canvas_setting_item = fun ~config variable canvas_renderer -> object - inherit canvas_float_item canvas_renderer as item + inherit canvas_float_item ~config canvas_renderer as item method clicked = fun value -> (variable#set : float -> unit) value @@ -271,7 +272,7 @@ class canvas_setting_item = fun variable canvas_renderer -> provided callback *) class canvas_clickable_item = fun type_ properties callback canvas_renderer -> object - inherit canvas_item canvas_renderer as item + inherit canvas_item ~config:properties canvas_renderer as item method edit = fun () -> callback () method config = fun () -> diff --git a/sw/lib/ocaml/papget_renderer.ml b/sw/lib/ocaml/papget_renderer.ml index 707b045355..c58d21dca5 100644 --- a/sw/lib/ocaml/papget_renderer.ml +++ b/sw/lib/ocaml/papget_renderer.ml @@ -143,7 +143,12 @@ class canvas_ruler = fun ?(config=[]) canvas_group x y -> let value = float_of_string value in drawer value method item = (root :> movable_item) - method config = fun () -> config (* Not editable *) + method config = fun () -> + [ PC.float_property "height" h; + PC.property "index_of_right" (sprintf "%b" index_on_right); + PC.float_property "scale" scale; + PC.float_property "width" w; + PC.property "scale" (sprintf "%d" step) ] end (*************************** Gauge ***********************************)