*** empty log message ***

conf/flight_plans/sinsat.xml

@@ -0,0 +1,27 @@
+<flight_plan SECURITY_HEIGHT="25" lat0="42.799347" lon0="1.665094" ground_alt="507" qfu="270" alt="550" max_dist_from_home="500" name="Sinsat">
+  <rc_control>
+    <mode NAME="AUTO1">
+      <setting VAR="ir_pitch_neutral" RANGE="60." RC="gain_1_up" TYPE="int16"/>
+      <setting VAR="ir_roll_neutral" RANGE="-60." RC="gain_1_down" TYPE="int16"/>
+    </mode>
+    <mode NAME="AUTO2">
+      <setting VAR="course_pgain" RANGE="0.1" RC="gain_1_up" TYPE="float"/>
+      <setting VAR="pitch_of_roll" RANGE=".2" RC="gain_1_down" TYPE="float"/>
+    </mode>
+  </rc_control>
+  <waypoints>
+    <waypoint Y="0" NAME="HOME" X="0"/>
+  </waypoints>
+  <blocks>
+    <block NAME="init">
+      <while COND="(!launch)"/>
+      <heading GAZ="0.8" PITCH="0.15" COURSE="QFU" UNTIL="(estimator_flight_time > 8)" VMODE="gaz"/>
+      <heading PITCH="0.15" CLIMB="3.0" COURSE="QFU" UNTIL="(estimator_z > SECURITY_ALT)" VMODE="climb"/>
+      <deroute BLOCK="circlehome"/>
+    </block>
+    <block NAME="circlehome">
+      <circle WP="HOME" ALT="GROUND_ALT+50" RADIUS="75"/>
+    </block>
+  </blocks>
+</flight_plan>
+

sw/lib/ocaml/ml_gtk_drag.c

@@ -0,0 +1,32 @@
+#include <string.h>
+#include <gtk/gtk.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+
+extern value Val_GtkTreePath(GtkTreePath*);
+
+#define Pointer_val(val) ((void*)Field(val,1))
+
+#ifdef G_DISABLE_CAST_CHECKS
+#define check_cast(f,v) f(Pointer_val(v))
+#else
+#define check_cast(f,v) (Pointer_val(v) == NULL ? NULL : f(Pointer_val(v)))
+#endif
+
+#define GtkTreeView_val(val) check_cast(GTK_TREE_VIEW,val)
+
+CAMLprim value
+ml_gtk_tree_view_get_drag_dest_row(value val_tree) {
+  CAMLparam0();
+  CAMLlocal1(ret);
+  GtkTreePath *path;
+  GtkTreeViewDropPosition pos;
+  gtk_tree_view_get_drag_dest_row(GtkTreeView_val(val_tree), &path, &pos);
+  ret = alloc_tuple(2);
+  Store_field(ret,0,Val_GtkTreePath(path));
+  Store_field(ret,1,Val_int(pos));
+  CAMLreturn(ret);
+}

sw/lib/ocaml/xmlEdit.ml

@@ -0,0 +1,447 @@
+(*
+ * $Id$
+ *
+ * XML editor
+ *  
+ * Copyright (C) 2004 CENA/ENAC, Pascal Brisset, Antoine Drouin
+ *
+ * This file is part of paparazzi.
+ *
+ * paparazzi is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * paparazzi is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with paparazzi; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 59 Temple Place - Suite 330,
+ * Boston, MA 02111-1307, USA. 
+ *
+ *)
+
+type gtkTreeViewDropPosition =
+    GTK_TREE_VIEW_DROP_BEFORE
+  | GTK_TREE_VIEW_DROP_AFTER
+  | GTK_TREE_VIEW_DROP_INTO_OR_BEFORE
+  | GTK_TREE_VIEW_DROP_INTO_OR_AFTER
+
+external gtk_tree_view_get_drag_dest_row : 'a Gtk.obj -> Gtk.tree_path * gtkTreeViewDropPosition = "ml_gtk_tree_view_get_drag_dest_row"
+
+open Printf
+
+type tag = string
+type attributes = (string * string) list
+type t = GTree.tree_store
+type node = t * Gtk.tree_path
+
+let cols = new GTree.column_list
+let attribute = cols#add Gobject.Data.string
+let value = cols#add Gobject.Data.string
+
+let model_of_attribs = fun () ->
+  GTree.tree_store cols
+
+let set_attr_value = fun (store:GTree.tree_store) row (a, v) ->
+  store#set ~row ~column:attribute a;
+  store#set ~row ~column:value v
+
+let set_attributes = fun (store:GTree.tree_store) attribs ->
+  List.iter 
+    (fun (a, v) -> 
+      let row = store#append () in
+      set_attr_value store row (a,v))
+    attribs
+
+let attribs_of_model = fun (store:GTree.tree_store) ->
+  let l = ref [] in
+  store#foreach
+    (fun _path row ->
+      l := (store#get ~row ~column:attribute, store#get ~row ~column:value):: !l;
+      false);
+  List.rev !l
+		  
+
+let editable_renderer = fun (model:GTree.tree_store) column ->
+  let r = GTree.cell_renderer_text [`EDITABLE true] in
+  let _ = r#connect#edited ~callback:
+      (fun path s ->
+	model#set ~row:(model#get_iter path) ~column s
+      ) in
+  r
+
+let attribs_view = fun model window ->
+  let view = GTree.view ~model ~packing:window#add () in
+  let r = editable_renderer model attribute in
+  let col = GTree.view_column ~title:"Attribute" ()
+      ~renderer:(r, ["text",attribute]) in
+  
+  ignore (view#append_column col);
+  let r = editable_renderer model value in
+  let col = GTree.view_column ~title:"Value" () ~renderer:(r, ["text",value]) in
+  ignore (view#append_column col);
+  view
+
+type event = Deleted | Modified of attributes | New_child of node
+
+let cols = new GTree.column_list
+let tag_col = cols#add Gobject.Data.string
+let attributes = cols#add Gobject.Data.caml
+let event = cols#add Gobject.Data.caml
+
+let string_of_attribs = fun attribs ->
+  List.fold_right (fun (a,v) r -> sprintf " %s=\"%s\"%s" a v r) attribs ""
+
+let set_xml = fun (store:GTree.tree_store) row xml ->
+  store#set ~row ~column:tag_col (Xml.tag xml);
+  store#set ~row ~column:attributes (Xml.attribs xml);
+  store#set ~row ~column:event (fun _ -> ())
+
+
+let rec insert_xml = fun (store:GTree.tree_store) parent xml ->
+  let row = store#append ~parent () in
+  set_xml store row xml;
+  List.iter (fun x -> insert_xml store row x) (Xml.children xml)
+
+
+let tree_model_of_xml = fun xml ->
+  let store = GTree.tree_store cols in
+  let row = store#append () in
+  set_xml store row xml;
+  List.iter (fun x -> insert_xml store row x) (Xml.children xml);
+  store;;
+
+
+let attrib_cell_data_func = fun renderer (model:GTree.model) iter ->
+  let value = model#get ~row:iter ~column:attributes in
+  renderer#set_properties [`TEXT (string_of_attribs value)]
+
+let tree_view = fun (model:GTree.tree_store) window ->
+  let view = GTree.view ~model ~reorderable:true ~packing:window#add () in
+  let r = GTree.cell_renderer_text [] in
+  let col = GTree.view_column ~title:"Tag" () ~renderer:(r, ["text",tag_col]) in
+  let _ = r#connect#edited ~callback:
+      (fun path s ->
+	model#set ~row:(model#get_iter path) ~column:tag_col s
+      ) in
+  ignore (view#append_column col);
+  let r = GTree.cell_renderer_text [] in
+  let col = GTree.view_column ~title:"Attributes" ()
+      ~renderer:(r, []) in
+  col#set_cell_data_func r (attrib_cell_data_func r);
+  col#set_max_width 300;
+  ignore (view#append_column col);
+  view
+
+(** Returns the list of all the tags appearing in the given DTD element *)
+let rec tags r = function
+    Dtd.DTDTag s -> s::r
+  | Dtd.DTDPCData -> r
+  | Dtd.DTDOptional dtd_child | Dtd.DTDZeroOrMore dtd_child | Dtd.DTDOneOrMore dtd_child ->
+      tags r dtd_child
+  | Dtd.DTDChoice dtd_childs | Dtd.DTDChildren dtd_childs ->
+      List.fold_right (fun dc r -> tags r dc) dtd_childs r
+
+(** Returns the list of tags of possible children of the given [tag] *)
+let dtd_children = fun tag dtd ->
+  let rec search = function
+      Dtd.DTDElement (t,det)::_ when t = tag -> det
+    | _::is -> search is
+    | [] -> raise Not_found in
+  match search dtd with
+    Dtd.DTDChild dc ->
+      tags [] dc
+  | _ -> []
+
+
+(** Make a submenu with labels from [labels]. Attach the generic [callback]
+which argument is the selected label *)
+let submenu = fun menuitem ss connect ->
+  let submenu = GMenu.menu () in
+  List.iter 
+    (fun tag ->
+      let menuitem = GMenu.menu_item ~label:tag ~packing:submenu#append () in
+      let _c = menuitem#connect#activate ~callback:(fun () -> connect tag) in
+      ())
+    ss;
+  menuitem#set_submenu submenu
+
+(** Returns the compulsory attibutes of a given tag *)
+let required_attributes = fun tag dtd ->
+  let rec filter = function
+      Dtd.DTDAttribute (t, a, _, (Dtd.DTDDefault s|Dtd.DTDFixed s))::dis when t = tag -> (a,s)::filter dis
+    | Dtd.DTDAttribute (t, a, _, Dtd.DTDRequired)::dis when t = tag -> (a,"???")::filter dis
+    | _::dis -> filter dis
+    | [] -> [] in
+  filter dtd
+      
+let allowed_attributes = fun tag dtd ->
+  let rec filter = function
+    | Dtd.DTDAttribute (t, a, _, _)::dis when t = tag -> a::filter dis
+    | _::dis -> filter dis
+    | [] -> [] in
+  filter dtd
+      
+let attr_submenu = fun menuitem tag dtd connect ->
+   submenu menuitem (allowed_attributes tag dtd) connect
+	
+
+let attribs_menu_popup = fun dtd (tree_view:GTree.view) (model:GTree.tree_store) (attrib_row:Gtk.tree_iter) ->
+  let menu = GMenu.menu () in
+  let menuitem = GMenu.menu_item ~label:"Delete" ~packing:menu#append () in
+  ignore (menuitem#connect#activate ~callback:(fun () -> ignore (model#remove attrib_row)));
+  begin
+    match tree_view#selection#get_selected_rows with
+      path::_ ->
+	let tree_model = tree_view#model in
+	let row = tree_model#get_iter path in
+	let current_tag = tree_model#get ~row ~column:tag_col in
+	let menuitem = GMenu.menu_item ~label:"Add after" ~packing:menu#append () in
+	let connect = fun a ->
+	  let row = model#insert_after attrib_row in
+	  let av = (a, "???") in
+	  set_attr_value model row av in
+	attr_submenu menuitem current_tag dtd connect
+    | _ -> ()
+  end;
+  menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ())
+
+let add_one_menu = fun dtd (tree_view:GTree.view) (model:GTree.tree_store) ->
+   match tree_view#selection#get_selected_rows with
+      path::_ ->
+	let tree_model = tree_view#model in
+	let row = tree_model#get_iter path in
+	let current_tag = tree_model#get ~row ~column:tag_col in
+	let menu = GMenu.menu () in
+	let menuitem = GMenu.menu_item ~label:"Add one" ~packing:menu#append () in
+	let connect = fun a ->
+	      let row = model#append () in
+	      let av = (a, "???") in
+	      set_attr_value model row av in
+	attr_submenu menuitem current_tag dtd connect;
+	menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ())
+   | _ -> ()
+
+
+let add_context_menu = fun model view ?noselection_menu menu ->
+  view#event#connect#button_press ~callback:
+    (fun ev ->
+      if GdkEvent.Button.button ev = 3 then
+	match view#selection#get_selected_rows, noselection_menu with
+	  path::_, _ ->
+	    let row = model#get_iter path in
+	    menu model row;
+	    true
+	| [], Some menu ->
+	    menu model;
+	    true
+	| _ -> false
+      else
+	false)
+
+let root = fun (model:t) ->
+  match model#get_iter_first with
+    None -> invalid_arg "XmlEdit.root"
+  | Some i -> (model, model#get_path i)
+
+  
+let attribs = fun ((model:t), path) ->
+  let row = model#get_iter path in
+  model#get ~row ~column:attributes
+
+let set_attribs = fun ((model:t), path) attribs ->
+  let row = model#get_iter path in
+  model#set ~row ~column:attributes attribs
+
+let attrib = fun node at ->
+  let at = String.uppercase at in
+  let ats = attribs node in
+  let rec loop = function
+      [] -> raise Not_found
+    | (a,v)::avs ->
+	if String.uppercase a = at then v else loop avs in
+  loop ats
+
+let tag = fun ((model:t), path) ->
+  let row = model#get_iter path in
+  model#get ~row ~column:tag_col
+
+let children = fun ((model:t), path) ->
+  let row = model#get_iter path in
+  if model#iter_has_child row then
+    let i = model#iter_children (Some row) in
+    let l = ref [model, model#get_path i] in
+    while model#iter_next i do 
+      l := (model, model#get_path i):: !l;
+    done;
+    List.rev !l
+  else
+    []
+
+let rec xml_of_node = fun node -> 
+  let attrs = attribs node
+  and tag = tag node
+  and children = List.map xml_of_node (children node) in
+  Xml.Element (tag, attrs, children)
+
+let xml_of_view = fun (tree:t) ->
+  xml_of_node (root tree)
+  
+let child = fun ((model:t), path) (t:string) ->
+  let row = model#get_iter path in
+  if model#iter_has_child row then
+    let i = model#iter_children (Some row) in
+    let rec loop = fun () ->
+      if model#get ~row:i ~column:tag_col = t then
+	(model, model#get_path i)
+      else if model#iter_next i then
+	loop ()
+      else failwith (sprintf "XmlEdit.child: %s" t) in
+    loop ()
+  else
+    failwith (sprintf "XmlEdit.child: %s" t)
+    
+
+let delete = fun ((model:t), path) ->
+  let row = model#get_iter path in
+  if model#iter_is_valid row then
+    ignore (model#remove row)
+
+let add_child = fun ((model, path):node) tag attribs ->
+  let parent = model#get_iter path in
+  let row = model#append ~parent () in
+  model#set ~row ~column:tag_col tag;
+  model#set ~row ~column:attributes attribs;
+  model, model#get_path row
+
+let connect = fun ((model, path):node) cb ->
+  let row = model#get_iter path in
+  model#set ~row ~column:event cb
+
+let tree_menu_popup = fun dtd (model:GTree.tree_store) (row:Gtk.tree_iter) ->
+  let menu = GMenu.menu () in
+  let menuitem = GMenu.menu_item ~label:"Delete" ~packing:menu#append () in
+  ignore (menuitem#connect#activate ~callback:(fun () -> ignore (model#get ~row ~column:event Deleted; model#remove row)));
+  let row_tag = model#get ~row ~column:tag_col in
+  let tags = dtd_children row_tag dtd in
+  if tags <> [] then begin
+    let menuitem = GMenu.menu_item ~label:"Add child" ~packing:menu#append () in
+    let connect = fun t ->
+      let parent = row in
+      let row = model#append ~parent () in
+      let attrs = required_attributes t dtd in
+      let xml = Xml.Element (t, attrs, []) in
+      set_xml model row xml;
+      model#get ~row:parent ~column:event (New_child (model, model#get_path row)) in
+    submenu menuitem tags connect
+  end;
+  begin
+    match model#iter_parent row with
+      Some parent ->
+	let copy = fun () ->
+	  let xml = xml_of_node (model,(model#get_path row)) in
+	  let row = model#insert_after ~parent row in
+	  set_xml model row xml;
+	  model#get ~row:parent ~column:event (New_child (model, model#get_path row));
+	  List.iter (insert_xml model row) (Xml.children xml)
+	in
+	let menuitem = GMenu.menu_item ~label:"Copy after" ~packing:menu#append () in
+	ignore (menuitem#connect#activate ~callback:copy);
+
+	let menuitem = GMenu.menu_item ~label:"Add after" ~packing:menu#append () in
+	let parent_tag = model#get ~row:parent ~column:tag_col in
+	let connect = fun t ->
+	  let row = model#insert_after ~parent row in
+	  let attrs = required_attributes t dtd in
+	  let xml = Xml.Element (t, attrs, []) in
+	  set_xml model row xml;
+	  model#get ~row:parent ~column:event (New_child (model, model#get_path row))
+	in
+	let tags = dtd_children parent_tag dtd in
+	submenu menuitem tags connect
+    | _ -> () 
+  end;
+  menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ())
+
+
+  
+let create = fun dtd xml ->
+  let tree_model = tree_model_of_xml xml in
+  let attribs_model = model_of_attribs () in
+  let window = GWindow.window () in
+  let hbox = GPack.hbox ~packing:window#add () in
+  let tree_view = tree_view tree_model hbox in
+  tree_view#set_border_width 10;
+  let attribs_view = attribs_view attribs_model hbox in
+  attribs_view#set_border_width 10;
+
+  let update_tree = fun _path ->
+    match tree_view#selection#get_selected_rows with
+      path::_ ->
+	let row = tree_model#get_iter path in
+	let new_attribs = attribs_of_model attribs_model in
+	tree_model#set ~row ~column:attributes new_attribs;
+	tree_model#get ~row ~column:event (Modified new_attribs)
+    | _ -> ()
+  in
+  let _attribs_changed = attribs_model#connect#row_changed ~callback:(fun p _i -> update_tree p) in
+  ignore (attribs_model#connect#row_deleted ~callback:update_tree);
+
+  let tag_of_last_selection = ref "" in
+
+  let selection_changed = fun () ->
+      match tree_view#selection#get_selected_rows with
+	path::_ ->
+	  let row = tree_model#get_iter path in
+	  let attribs = tree_model#get ~row ~column:attributes in
+	  attribs_model#clear ();
+	  tag_of_last_selection := tree_model#get ~row ~column:tag_col;
+	  set_attributes attribs_model attribs
+      | _ -> () in
+
+  let _c = tree_view#selection#connect#after#changed ~callback:selection_changed in
+
+  let _c = add_context_menu tree_model tree_view (tree_menu_popup dtd) in
+  let _c = add_context_menu attribs_model attribs_view ~noselection_menu:(add_one_menu dtd tree_view) (attribs_menu_popup dtd tree_view) in
+
+  (* Controlled drag and drop.
+     Handling of dropable row cannot be done inside motion handling since
+     the context refers to the whole widget, not the current row. The trick
+     here is to use a boolean, set during motion and checked in drop event *)
+  let dropable = ref false in
+  let motion = fun _context ~x ~y ~time ->
+    try
+      let path, i = gtk_tree_view_get_drag_dest_row tree_view#as_widget in
+      let row = tree_model#get_iter path in
+      let row_tag = (tree_model#get ~row ~column:tag_col) in
+      dropable := begin
+	match i with
+	  GTK_TREE_VIEW_DROP_INTO_OR_BEFORE
+	| GTK_TREE_VIEW_DROP_INTO_OR_AFTER ->
+	    List.mem !tag_of_last_selection (dtd_children row_tag dtd)
+	| _ ->
+	    match tree_model#iter_parent row with
+	      None -> false
+	    | Some parent ->
+		let parent_tag = tree_model#get ~row:parent ~column:tag_col in
+		List.mem !tag_of_last_selection (dtd_children parent_tag dtd)
+      end;
+      false
+    with
+      Gpointer.Null -> false in
+  let drop = fun (context:GObj.drag_context) ~x ~y ~time ->
+    if !dropable then
+      false
+    else begin
+      context#status None;
+      true
+    end in
+  let _ = tree_view#drag#connect#motion ~callback:motion in
+  let _ = tree_view#drag#connect#drop ~callback:drop in
+
+  window#show ();
+  tree_model

sw/lib/ocaml/xmlEdit.mli

@@ -0,0 +1,65 @@
+(*
+ * $Id$
+ *
+ * XML editor
+ *  
+ * Copyright (C) 2004 CENA/ENAC, Pascal Brisset, Antoine Drouin
+ *
+ * This file is part of paparazzi.
+ *
+ * paparazzi is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * paparazzi is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with paparazzi; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 59 Temple Place - Suite 330,
+ * Boston, MA 02111-1307, USA. 
+ *
+ *)
+
+(** XML types base on th xml-light library *)
+
+type t
+(** The whole XML data structure *)
+
+type node
+(** One data structure node. Warning: it is not an absolute
+node designation: it may not remain valid after strucure modifications
+(reordering, deletion addition, ... *)
+
+type tag = string
+type attributes = (string * string) list
+
+type event = Deleted | Modified of attributes | New_child of node
+
+val create : Dtd.dtd -> Xml.xml -> t
+(** [create dtd xml] Opens a display of [xml] with contextual right button
+actions constrained by [dtd]. Returns the corresponding model. *)
+
+val xml_of_view : t -> Xml.xml
+(** [xml_of_view v] Returns the XML displayed data structure *)
+
+val root : t -> node
+
+val child : node -> tag -> node
+val tag : node -> string
+val attribs : node -> attributes
+val attrib : node -> string -> string (* No case match *)
+val children : node -> node list
+(** Xml-light like acces functions *)
+
+val set_attribs : node -> attributes -> unit
+val delete : node -> unit
+val add_child : node -> tag -> attributes -> node
+(** Modifications *)
+
+val connect : node -> (event -> unit) -> unit
+(** To be kept informed about modifications *)
+