[paparazzi-commits] [4789] add a new "led" papget

[Gautier Hattenberger]

Revision: 4789
          http://svn.sv.gnu.org/viewvc/?view=rev&root=paparazzi&revision=4789
Author:   gautier
Date:     2010-04-08 14:29:51 +0000 (Thu, 08 Apr 2010)
Log Message:
-----------
add a new "led" papget

Modified Paths:
--------------
    paparazzi3/trunk/sw/ground_segment/cockpit/papgets.ml
    paparazzi3/trunk/sw/lib/ocaml/Makefile
    paparazzi3/trunk/sw/lib/ocaml/papget_renderer.ml
    paparazzi3/trunk/sw/lib/ocaml/papget_renderer.mli
    paparazzi3/trunk/sw/lib/ocaml/widgets.glade

Modified: paparazzi3/trunk/sw/ground_segment/cockpit/papgets.ml
===================================================================
--- paparazzi3/trunk/sw/ground_segment/cockpit/papgets.ml       2010-04-04 
17:04:13 UTC (rev 4788)
+++ paparazzi3/trunk/sw/ground_segment/cockpit/papgets.ml       2010-04-08 
14:29:51 UTC (rev 4789)
@@ -87,6 +87,8 @@
        (new Papget_renderer.canvas_ruler canvas_group ~config x y :> 
Papget_renderer.t)
     | "gauge" ->
        (new Papget_renderer.canvas_gauge ~config canvas_group x y :> 
Papget_renderer.t)
+    | "led" ->
+       (new Papget_renderer.canvas_led ~config canvas_group x y :> 
Papget_renderer.t)
     | _ -> failwith (sprintf "Unexpected papget display: %s" display) in
   
   let p = new Papget.canvas_display_float_item ~config listener renderer in

Modified: paparazzi3/trunk/sw/lib/ocaml/Makefile
===================================================================
--- paparazzi3/trunk/sw/lib/ocaml/Makefile      2010-04-04 17:04:13 UTC (rev 
4788)
+++ paparazzi3/trunk/sw/lib/ocaml/Makefile      2010-04-08 14:29:51 UTC (rev 
4789)
@@ -35,7 +35,7 @@
 CMO = $(SRC:.ml=.cmo)
 CMX = $(SRC:.ml=.cmx)
 
-XSRC = gtk_tools.ml platform.ml wind_sock.ml gtk_papget_editor.ml 
gtk_papget_text_editor.ml gtk_papget_gauge_editor.ml papget_common.ml 
papget_renderer.ml papget.ml mapCanvas.ml mapWaypoints.ml mapTrack.ml 
mapGoogle.ml mapIGN.ml ml_gtk_drag.o xmlEdit.ml mapFP.ml
+XSRC = gtk_tools.ml platform.ml wind_sock.ml gtk_papget_editor.ml 
gtk_papget_text_editor.ml gtk_papget_gauge_editor.ml gtk_papget_led_editor.ml 
papget_common.ml papget_renderer.ml papget.ml mapCanvas.ml mapWaypoints.ml 
mapTrack.ml mapGoogle.ml mapIGN.ml ml_gtk_drag.o xmlEdit.ml mapFP.ml
 XCMO = $(XSRC:.ml=.cmo)
 XCMX = $(XSRC:.ml=.cmx)
 
@@ -135,6 +135,10 @@
        grep -v invisible_char $< > /tmp/$<
        lablgladecc2 -root table_gauge_editor -hide-default /tmp/$< | grep -B 
1000000 "  end" > $@
 
+gtk_papget_led_editor.ml : widgets.glade
+       grep -v invisible_char $< > /tmp/$<
+       lablgladecc2 -root table_led_editor -hide-default /tmp/$< | grep -B 
1000000 "  end" > $@
+
 clean :
        rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so tests gtk_papget_*.ml 
expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli
 

Modified: paparazzi3/trunk/sw/lib/ocaml/papget_renderer.ml
===================================================================
--- paparazzi3/trunk/sw/lib/ocaml/papget_renderer.ml    2010-04-04 17:04:13 UTC 
(rev 4788)
+++ paparazzi3/trunk/sw/lib/ocaml/papget_renderer.ml    2010-04-08 14:29:51 UTC 
(rev 4789)
@@ -240,6 +240,66 @@
         PC.property "text" text ]
   end
 
+(*************************** Led ***********************************)
+class canvas_led = fun ?(config=[]) canvas_group x y ->
+  let size = float_of_string (PC.get_prop "size" config "15.") in
+  let text = PC.get_prop "text" config "" in
+
+  let root = GnoCanvas.group ~x ~y canvas_group in
+  
+  let r = (Pervasives.max 2. (size /. 2.)) +. 1. in
+  let led = GnoCanvas.ellipse ~x1:r ~y1:r ~x2:(-.r) ~y2:(-.r)
+    ~props:[`NO_FILL_COLOR; `OUTLINE_COLOR "grey"; `WIDTH_UNITS 2.]  root in
+
+  let led_text = GnoCanvas.text ~x:(-.r-.3.) ~y:0. ~props:[`ANCHOR `EAST; 
`FILL_COLOR "green"] root in
+
+  object
+    val mutable size = float_of_string (PC.get_prop "size" config "15.")
+    val mutable text = PC.get_prop "text" config ""
+    val mutable test_value = float_of_string (PC.get_prop "test_value" config 
"0.")
+    val mutable test_inv = bool_of_string (PC.get_prop "test_invert" config 
"false")
+
+    method tag = "Led"
+    method edit = fun (pack:GObj.widget -> unit) ->
+      let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // 
"widgets.glade" in
+      let led_editor = new Gtk_papget_led_editor.table_led_editor ~file () in
+      pack led_editor#table_led_editor#coerce;
+
+      (* Initialize the entries *)
+      led_editor#entry_text#set_text text;
+      led_editor#spinbutton_size#set_value size;
+      led_editor#spinbutton_test#set_value test_value;
+
+      (* Connect the entries *)
+      let callback = fun () ->
+        text <- led_editor#entry_text#text in
+      ignore (led_editor#entry_text#connect#activate ~callback);
+      let callback = fun () ->
+        size <- led_editor#spinbutton_size#value in
+      ignore (led_editor#spinbutton_size#connect#activate ~callback);
+      let callback = fun () ->
+        test_value <- led_editor#spinbutton_test#value in
+      ignore (led_editor#spinbutton_test#connect#activate ~callback);
+      let callback = fun () ->
+        test_inv <- led_editor#check_invert#active in
+      ignore (led_editor#check_invert#connect#toggled ~callback);
+
+    method update = fun value ->
+      let value = float_of_string value in
+      let inv = if test_inv then not else (fun x -> x) in
+      (* Led drawer *)
+      if inv (value = test_value) then led#set [`FILL_COLOR "red"]
+      else led#set [`FILL_COLOR "green"];
+      let r = (Pervasives.max 2. (size /. 2.)) +. 1. in
+      led#set [`X1 r; `Y1 r; `X2 (-.r); `Y2 (-.r)];
+      led_text#set [`TEXT text; `SIZE_POINTS size; `X (-.r-.3.)]
+
+    method item = (root :> movable_item)
+    method config = fun () ->
+      [ PC.float_property "size" size;
+        PC.property "text" text ]
+  end
+
 (****************************************************************************)
 class canvas_button = fun ?(config=[]) canvas_group x y ->
   let icon = PC.get_prop "icon" config "icon_file" in
@@ -288,7 +348,8 @@
 let renderers =
   [ (new canvas_text :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> 
float -> t);
     (new canvas_ruler :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> 
float -> t);
-    (new canvas_gauge :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> 
float -> t) ] 
+    (new canvas_gauge :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> 
float -> t);
+    (new canvas_led :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> 
float -> t) ] 
 
 let lazy_tagged_renderers = lazy
     (let x = 0. and y = 0.

Modified: paparazzi3/trunk/sw/lib/ocaml/papget_renderer.mli
===================================================================
--- paparazzi3/trunk/sw/lib/ocaml/papget_renderer.mli   2010-04-04 17:04:13 UTC 
(rev 4788)
+++ paparazzi3/trunk/sw/lib/ocaml/papget_renderer.mli   2010-04-08 14:29:51 UTC 
(rev 4789)
@@ -48,6 +48,9 @@
 class canvas_gauge : ?config:Xml.xml list -> #GnoCanvas.group -> float -> 
float -> t
 (** [canvas_gauge config group x y] *)
 
+class canvas_led : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float 
-> t
+(** [canvas_led config group x y] *)
+
 class canvas_button : ?config:Xml.xml list -> #GnoCanvas.group -> float -> 
float -> t
 (** [canvas_button config group x y] *)
 

Modified: paparazzi3/trunk/sw/lib/ocaml/widgets.glade
===================================================================
--- paparazzi3/trunk/sw/lib/ocaml/widgets.glade 2010-04-04 17:04:13 UTC (rev 
4788)
+++ paparazzi3/trunk/sw/lib/ocaml/widgets.glade 2010-04-08 14:29:51 UTC (rev 
4789)
@@ -256,4 +256,109 @@
       </widget>
     </child>
   </widget>
+  <widget class="GtkWindow" id="papget_led_editor">
+    <property name="visible">True</property>
+    <property name="title" translatable="yes">Led Papget Properties</property>
+    <property name="window_position">mouse</property>
+    <child>
+      <widget class="GtkTable" id="table_led_editor">
+        <property name="visible">True</property>
+        <property name="n_rows">4</property>
+        <property name="n_columns">2</property>
+        <child>
+          <widget class="GtkLabel" id="label1">
+            <property name="visible">True</property>
+            <property name="label" translatable="yes">Text</property>
+          </widget>
+          <packing>
+            <property name="x_options">GTK_FILL</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkLabel" id="label2">
+            <property name="visible">True</property>
+            <property name="label" translatable="yes">Size</property>
+          </widget>
+          <packing>
+            <property name="top_attach">1</property>
+            <property name="bottom_attach">2</property>
+            <property name="x_options">GTK_FILL</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkSpinButton" id="spinbutton_size">
+            <property name="visible">True</property>
+            <property name="can_focus">True</property>
+            <property name="adjustment">15 2 100 1 10 0</property>
+          </widget>
+          <packing>
+            <property name="left_attach">1</property>
+            <property name="right_attach">2</property>
+            <property name="top_attach">1</property>
+            <property name="bottom_attach">2</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkEntry" id="entry_text">
+            <property name="visible">True</property>
+            <property name="can_focus">True</property>
+          </widget>
+          <packing>
+            <property name="left_attach">1</property>
+            <property name="right_attach">2</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkLabel" id="label3">
+            <property name="visible">True</property>
+            <property name="label" translatable="yes">Test invert</property>
+          </widget>
+          <packing>
+            <property name="top_attach">3</property>
+            <property name="bottom_attach">4</property>
+            <property name="x_options">GTK_FILL</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkCheckButton" id="check_invert">
+            <property name="visible">True</property>
+            <property name="can_focus">True</property>
+            <property name="receives_default">False</property>
+            <property name="draw_indicator">True</property>
+          </widget>
+          <packing>
+            <property name="left_attach">1</property>
+            <property name="right_attach">2</property>
+            <property name="top_attach">3</property>
+            <property name="bottom_attach">4</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkLabel" id="label4">
+            <property name="visible">True</property>
+            <property name="label" translatable="yes">Test value</property>
+          </widget>
+          <packing>
+            <property name="top_attach">2</property>
+            <property name="bottom_attach">3</property>
+            <property name="x_options">GTK_FILL</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkSpinButton" id="spinbutton_test">
+            <property name="visible">True</property>
+            <property name="can_focus">True</property>
+            <property name="adjustment">0 0 100 1 10 0</property>
+            <property name="climb_rate">1</property>
+          </widget>
+          <packing>
+            <property name="left_attach">1</property>
+            <property name="right_attach">2</property>
+            <property name="top_attach">2</property>
+            <property name="bottom_attach">3</property>
+          </packing>
+        </child>
+      </widget>
+    </child>
+  </widget>
 </glade-interface>