new "locked" option for papgets

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";

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 () ->

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 ***********************************)