diff --git a/sw/lib/ocaml/debug.ml b/sw/lib/ocaml/debug.ml index 8a0e1524e3..c37cdbcd54 100644 --- a/sw/lib/ocaml/debug.ml +++ b/sw/lib/ocaml/debug.ml @@ -25,16 +25,16 @@ *) let level = ref (try Sys.getenv "PPRZ_DEBUG" with Not_found -> "") - let log = ref stderr - let call lev f = - assert( (* assert permet au compilo de tout virer avec l'option -noassert *) - if (String.contains !level '*' || String.contains !level lev) - then begin - f !log; - flush !log - end; - true) - +let log = ref stderr +let call lev f = + assert( (* assert permet au compilo de tout virer avec l'option -noassert *) + if (String.contains !level '*' || String.contains !level lev) + then begin + f !log; + flush !log + end; + true) + let xprint = fun s -> let n = String.length s in let a = String.make (3*n) ' ' in diff --git a/sw/lib/ocaml/debug.mli b/sw/lib/ocaml/debug.mli new file mode 100644 index 0000000000..b550aeebfe --- /dev/null +++ b/sw/lib/ocaml/debug.mli @@ -0,0 +1,50 @@ +(* + * $Id$ + * + * Debugging facilities + * + * 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. + * + *) + +(** Module for outputting debug information *) + +val log : out_channel ref +(** The log file. Default value is "debug_log". The debug output channel can + be changed by [Debug.log := out_channel]. + The output channel gets back to its default value after each call to + [Debug.call] *) + +val call : char -> (out_channel -> unit) -> unit +(** [call debug_level output_function] outputs a message to the current + channel [!Debug.log] + [debug_level] is a flag to categorize the debug message. + The environment variable OPAS_DEBUG contains the active debug levels. + [call debug_level output_function] outputs its message iff OPAS_DEBUG + contains the character [debug_level] or [*] + [output_function] + [Debug.call 'x' (fun c -> Printf.fprintf c "message")] outputs ["message"] + iff the flag 'x' is active (ie OPAS_DEBUG contains the character ['x']) *) + +(** No debug information is output if the program was compiled with the + -noassert flag *) + +val xprint : string -> string +(** Returns the hexadecimal representation of a string *) diff --git a/sw/lib/ocaml/env.mli b/sw/lib/ocaml/env.mli new file mode 100644 index 0000000000..76fc5e1eb2 --- /dev/null +++ b/sw/lib/ocaml/env.mli @@ -0,0 +1,31 @@ +(* + * $Id$ + * + * Configuration handling + * + * Copyright (C) 2004 CENA/ENAC, Yann Le Fablec, 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. + * + *) + +val paparazzi_home : string +(** User's files directory *) + +val paparazzi_src : string +(** Installation's files directory *) diff --git a/sw/lib/ocaml/extXml.ml b/sw/lib/ocaml/extXml.ml index f449f34219..5379807429 100644 --- a/sw/lib/ocaml/extXml.ml +++ b/sw/lib/ocaml/extXml.ml @@ -30,7 +30,7 @@ let sep = Str.regexp "\\." let child xml ?select c = let rec find = function - Xml.Element (tag, attributes, _children) as elt :: elts -> + Xml.Element (tag, _attributes, _children) as elt :: elts -> if tag = c then match select with None -> elt diff --git a/sw/lib/ocaml/extXml.mli b/sw/lib/ocaml/extXml.mli new file mode 100644 index 0000000000..df33e0f402 --- /dev/null +++ b/sw/lib/ocaml/extXml.mli @@ -0,0 +1,48 @@ +(* + * $Id$ + * + * Xml-Light extension + * + * Copyright (C) 2004 CENA/ENAC, Pascal Brisset + * + * 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. + * + *) + +exception Error of string +val child : Xml.xml -> ?select:(Xml.xml -> bool) -> string -> Xml.xml +(** [child xml ?p i] If [i] is an integer, returns the [i]'th child of [xml]. +Else returns the child of [xml] with tag [i] (the first one satisfying [p] +if specified *) + +val get : Xml.xml -> string -> Xml.xml +(** [get xml path] Returns the son of [xml] specified by [path] (where +separator is [.] *) + +val get_attrib : Xml.xml -> string -> string -> string +(** [get_attrib xml path attrib_name] *) + +val attrib : Xml.xml -> string -> string +(** [get xml attribute_name] May raise [Error] *) + +val attrib_or_default : Xml.xml -> string -> string -> string +(** [get xml attribute_name default_value] *) + +val to_string_fmt : Xml.xml -> string +(** [to_string_fmt xml] Returns a formatted string where tag and attribute +names are lowercase *) diff --git a/sw/lib/ocaml/geometry_2d.ml b/sw/lib/ocaml/geometry_2d.ml index 9f96f18bc0..8e20a2b3c3 100644 --- a/sw/lib/ocaml/geometry_2d.ml +++ b/sw/lib/ocaml/geometry_2d.ml @@ -300,7 +300,7 @@ let test_on_hl t = (test_in_segment t)||(t=T_OUT_SEG_PT4)||(t=T_OUT_SEG_PT2) let crossing_seg_seg a b c d = match crossing_point a (vect_make a b) c (vect_make c d) with None -> false - | Some (type1, type2, pt) -> (test_in_segment type1)&&(test_in_segment type2) + | Some (type1, type2, _pt) -> (test_in_segment type1)&&(test_in_segment type2) (* ============================================================================= *) (* = Teste l'intersection d'un segment (a,b) et d'une demi-droite (c,v) = *) @@ -308,7 +308,7 @@ let crossing_seg_seg a b c d = let crossing_seg_hl a b c v = match crossing_point a (vect_make a b) c v with None -> false - | Some (type1, type2, pt) -> + | Some (type1, type2, _pt) -> (* OK si intersection sur la demi-droite *) (test_in_segment type1) && (test_on_hl type2) @@ -319,7 +319,7 @@ let crossing_hl_hl a u c v = let inter = crossing_point a u c v in match inter with None -> false - | Some (type1, type2, pt) -> (test_on_hl type1) && (test_on_hl type2) + | Some (type1, type2, _pt) -> (test_on_hl type1) && (test_on_hl type2) (* ============================================================================= *) (* = Teste l'intersection de deux droites et renvoie le point s'il existe = *) @@ -327,7 +327,7 @@ let crossing_hl_hl a u c v = let crossing_lines a u c v = match crossing_point a u c v with None -> (false, null_vector) - | Some (type1, type2, pt) -> (true, pt) + | Some (_type1, _type2, pt) -> (true, pt) (* ============================================================================= *) @@ -414,7 +414,6 @@ let convex_hull poly = | [] -> raise Exit in - let f (x,y) = {x2D=x;y2D=y} in let p a b = a.x2Db.y2D) in let l2=poly in let debut,_=extract_mini p l2 in @@ -431,7 +430,7 @@ let convex_hull poly = let crossing_seg_poly a b poly = (* Supprime les doublons dans une liste triee *) let supprime_doublons_points l = - let (p, new_l) = List.fold_left (fun (old, lst) pt -> + let (_p, new_l) = List.fold_left (fun (old, lst) pt -> match old with None -> (Some pt, [pt]) | Some p -> if point_same p pt then (old, lst) else (Some pt, pt :: lst) @@ -604,79 +603,6 @@ let poly_centroid poly = (* ============================================================================= *) -(* ============================================================================= *) -(* = Triangulation d'un polygone. Vielle version incorrecte dans certains cas = *) -(* ============================================================================= *) -let in_tesselation_old l0 = - (* Recherche des extremes et du centre *) - let {x2D=x; y2D=y} = List.hd l0 in - let xmin = ref x and xmax = ref x and ymin = ref y and ymax = ref y in - List.iter (fun {x2D=x; y2D=y} -> - if x< !xmin then xmin:=x; if x> !xmax then xmax:=x; - if y< !ymin then ymin:=y; if y> !ymax then ymax:=y) l0 ; - let dmax = max (!xmax -. !xmin) (!ymax -. !ymin) in - let pmid = point_middle {x2D= !xmin; y2D= !ymin} {x2D= !xmax; y2D= !ymax} in - - (* Recherche du triangle englobant (supertriangle) *) - let n = List.length l0 in - let t = Array.of_list (l0@[{x2D=pmid.x2D-.2.*.dmax; y2D=pmid.y2D-.dmax} ; - {x2D=pmid.x2D; y2D=pmid.y2D+.2.*.dmax} ; - {x2D=pmid.x2D+.2.*.dmax; y2D=pmid.y2D-.dmax}]) in - let triangles = ref [(n, n+1, n+2)] in - - (* Tous les points du contour sont inseres les uns apres les autres *) - Array.iteri (fun i point -> - let edges = ref [] in - - triangles := List.fold_left (fun l (p1, p2, p3) -> - (* Cercle circonscrit au triangle *) - let circle = circumcircle t.(p1) t.(p2) t.(p3) in - if point_in_circle point circle then begin - (* Ajout de 3 arretes et suppression du triangle en cours *) - edges := (p3,p1)::(p2,p3)::(p1,p2)::!edges ; l - end else (p1, p2, p3)::l) [] !triangles ; - - (* Creation de nouveaux triangles a partir du point courant pour les *) - (* arretes non multiples ou qui apparaissent un nombre impair de fois *) - let ledges = ref !edges in - List.iter (fun (n1, n2) -> - let l = List.find_all (fun (n01, n02) -> - (n01=n1&&n02=n2) or (n01=n2&&n02=n1)) !ledges in - if List.length l mod 2 <> 0 then begin - triangles:=(n1, n2, i)::!triangles; - (* Si l'arrete apparait un nombre impair de fois > 1 alors *) - (* on n'insere que ce triangle et pas les suivants, sinon *) - (* certains triangles apparaissent plusieurs fois *) - if List.length l>=3 then ledges:=!ledges@[(n1, n2)] - end) !edges) t ; - - let triangle_ok (p1, p2, p3) = - let check p1 p2 = - if p1-p2=1 or p2-p1=1 or (p1=0&&p2=n-1) or (p1=n-1&&p2=0) then true - else point_in_poly (point_middle t.(p1) t.(p2)) l0 - in - check p1 p2 && check p2 p3 && check p3 p1 - in - - (* Les triangles ayant des points du supertriangle sont elimines ainsi *) - (* que tous les triangles se trouvant a l'exterieur du contour initial *) - (* car ce cas arrive lorsque le contour original est concave... *) - let l = List.fold_left (fun l (p1, p2, p3) -> - if p1>=n or p2>=n or p3>=n or not (triangle_ok (p1, p2, p3)) then l - else (p1, p2, p3)::l) [] !triangles in - - (* Renvoie la liste des triangles CW *) - let l = List.map (fun (p1, p2, p3) -> - if ccw_angle t.(p1) t.(p2) t.(p3) = CW then (p1, p2, p3) else (p1, p3, p2)) l in - - (* Tableau des points et liste des triangles *) - (* Normalement, si n points differents au depart -> n-2 triangles en sortie *) - if List.length l0<>(List.length l)+2 then begin - Printf.printf "AAAA %d points %d triangles\n" (List.length l0) (List.length l); - flush stdout - end ; - (Array.of_list l0, l) - (* ============================================================================= *) (* = Triangulation d'un polygone = *) (* ============================================================================= *) @@ -797,7 +723,7 @@ let tesselation l = let in_tesselation_fans l = let t = Array.of_list l in let l = in_tesselation l in - let tt = Array.mapi (fun i x -> (i, 0)) t in + let tt = Array.mapi (fun i _x -> (i, 0)) t in let add_val x = let (p, n) = tt.(x) in tt.(x) <- (p, n+1) in List.iter (fun (p1, p2, p3) -> add_val p1; add_val p2; add_val p3) l ; diff --git a/sw/lib/ocaml/geometry_3d.ml b/sw/lib/ocaml/geometry_3d.ml index 6867fe79e5..19729cfe59 100644 --- a/sw/lib/ocaml/geometry_3d.ml +++ b/sw/lib/ocaml/geometry_3d.ml @@ -228,7 +228,7 @@ let test_on_hl t = (test_in_segment t)||(t=T_OUT_SEG_PT4)||(t=T_OUT_SEG_PT2) let crossing_seg_seg a b c d = match crossing_point a (vect_make a b) c (vect_make c d) with None -> false - | Some (type1, type2, pt) -> (test_in_segment type1)&&(test_in_segment type2) + | Some (type1, type2, _pt) -> (test_in_segment type1)&&(test_in_segment type2) (* ============================================================================= *) (* = Teste l'intersection d'un segment (a,b) et d'une demi-droite (c,v) = *) @@ -236,7 +236,7 @@ let crossing_seg_seg a b c d = let crossing_seg_hl a b c v = match crossing_point a (vect_make a b) c v with None -> false - | Some (type1, type2, pt) -> + | Some (type1, type2, _pt) -> (* OK si intersection sur la demi-droite *) (test_in_segment type1) && (test_on_hl type2) @@ -247,7 +247,7 @@ let crossing_hl_hl a u c v = let inter = crossing_point a u c v in match inter with None -> false - | Some (type1, type2, pt) -> (test_on_hl type1) && (test_on_hl type2) + | Some (type1, type2, _pt) -> (test_on_hl type1) && (test_on_hl type2) (* ============================================================================= *) (* = Teste l'intersection de deux droites et renvoie le point s'il existe = *) @@ -255,7 +255,7 @@ let crossing_hl_hl a u c v = let crossing_lines a u c v = match crossing_point a u c v with None -> (false, null_vector) - | Some (type1, type2, pt) -> (true, pt) + | Some (_type1, _type2, pt) -> (true, pt) (* ============================================================================= *) (* = Intersection d'une droite (a, u) et d'un plan (c, d, e) = *) @@ -544,7 +544,7 @@ let point_in_volume pt vol = (* On compte le nombre d'intersections entre la demi-droite issue du point *) (* a tester de vecteur directeur dir avec le volume *) - let is_in = ref false and list_inter = ref [] in + let is_in = ref false in List.iter (fun poly_face -> if List.length poly_face>=3 then begin (* 3 points definissant le plan contenant la face *) diff --git a/sw/lib/ocaml/gtk_3d.ml b/sw/lib/ocaml/gtk_3d.ml index a65dc5324b..914695cab5 100644 --- a/sw/lib/ocaml/gtk_3d.ml +++ b/sw/lib/ocaml/gtk_3d.ml @@ -94,7 +94,6 @@ type t_action = ACTION_NONE | ACTION_ZOOM of (int*int) | ACTION_ROTATE of (int*i let cursor_standard = Gdk.Cursor.create `LEFT_PTR let cursor_zoom_up = Gdk.Cursor.create `BASED_ARROW_UP let cursor_zoom_down = Gdk.Cursor.create `BASED_ARROW_DOWN -let cursor_wait = Gdk.Cursor.create `WATCH let cursor_rotate = Gdk.Cursor.create `EXCHANGE (* Valeurs OpenGL pour utiliser une source de lumiere *) @@ -413,8 +412,8 @@ let get_object_color obj = | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_color_out | ARROW_3D a -> a.arr3d_color | POINT_3D p -> p.p3d_color - | SURFACE_3D s -> glcolor_white - | SURFACE_3D_TEX s -> glcolor_white + | SURFACE_3D _s -> glcolor_white + | SURFACE_3D_TEX _s -> glcolor_white (* [set_object_color objet color] met a jour la couleur de l'objet *) let set_object_color obj color = @@ -450,9 +449,9 @@ let get_object_fill obj = | ENVELOPPE_3D e -> e.env3d_filled | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_filled | ARROW_3D a -> a.arr3d_filled - | POINT_3D p -> false + | POINT_3D _p -> false | SURFACE_3D s -> s.s3d_filled - | SURFACE_3D_TEX s -> true + | SURFACE_3D_TEX _s -> true (* [set_object_filled objet filled] force l'objet en mode plein ou fil de fer *) let set_object_fill obj filled = @@ -463,9 +462,9 @@ let set_object_fill obj filled = | ENVELOPPE_3D e -> e.env3d_filled <- filled | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_filled <- filled | ARROW_3D a -> a.arr3d_filled <- filled - | POINT_3D p -> () + | POINT_3D _p -> () | SURFACE_3D s -> s.s3d_filled <- filled - | SURFACE_3D_TEX s -> () + | SURFACE_3D_TEX _s -> () (* [get_line_width objet id] renvoie l'epaisseur d'un objet ligne. Si l'objet passe n'est pas du type [LINE_3D] alors l'exception {!Gtk_3d.NOT_A_3D_LINE} @@ -524,7 +523,7 @@ class widget_3d pack with_status_bar n = (a, fun msg -> ignore(ss#push msg)) end else (GlGtk.area [`RGBA; `DOUBLEBUFFER; `DEPTH_SIZE 1] ~packing:pack (), - fun msg -> ()) + fun _msg -> ()) in object (self) @@ -885,12 +884,12 @@ class widget_3d pack with_status_bar n = let old_rs = rs in let (do_it, l) = match o with - OUTLINE_3D o -> (false, []) + OUTLINE_3D _o -> (false, []) | LINE_3D l -> (true, l.line3d_points) | VOLUME1_3D v -> (true, v.vol3d_contour) | ENVELOPPE_3D e -> (true, e.env3d_contour) | ENVELOPPE_3D_DOUBLE e -> (true, e.env3d_double_contour_out) - | ARROW_3D a -> (false, []) + | ARROW_3D _a -> (false, []) | POINT_3D p -> (true, [p.p3d_pos; p.p3d_pos2]) | SURFACE_3D s -> let l = Array.to_list (Array.map (fun t -> Array.to_list t) s.s3d_pts) in @@ -1271,7 +1270,7 @@ class widget_3d pack with_status_bar n = current_action <- (ACTION_ROTATE mouse_pos) ; true (* [mouse_release ev] traite un evenement de relachement de bouton *) - method private mouse_release ev = + method private mouse_release _ev = (match current_action with ACTION_NONE -> () | _ -> self#reset_cursor) ; current_action <- ACTION_NONE ; true @@ -1437,7 +1436,7 @@ class widget_3d pack with_status_bar n = ignore(area#event#connect#any ~callback:scroll_cb) ; (* Attachement des callbacks pour les evenements clavier *) - Gtk_tools_GL.glarea_key_connect area self#key_pressed (fun k -> (); false) + Gtk_tools_GL.glarea_key_connect area self#key_pressed (fun _k -> (); false) end (* =============================== FIN ========================================= *) diff --git a/sw/lib/ocaml/gtk_draw.ml b/sw/lib/ocaml/gtk_draw.ml index ae53980752..487954600d 100644 --- a/sw/lib/ocaml/gtk_draw.ml +++ b/sw/lib/ocaml/gtk_draw.ml @@ -205,6 +205,5 @@ let gd_put_transp_pixmap p dest x y = dest#put_pixmap ~x:x ~y:y p#pixmap ; (* On enleve le masque *) - (match p#mask with None -> () | Some m -> prerr_endline "TODO (Gtk_draw): dest#unset_clip_mask") + (match p#mask with None -> () | Some _m -> prerr_endline "TODO (Gtk_draw): dest#unset_clip_mask") -(* =============================== FIN ========================================= *) diff --git a/sw/lib/ocaml/gtk_image.ml b/sw/lib/ocaml/gtk_image.ml index 922fa8016f..b2581fcbe6 100644 --- a/sw/lib/ocaml/gtk_image.ml +++ b/sw/lib/ocaml/gtk_image.ml @@ -309,7 +309,7 @@ let gtk_image_rgb24_of_image image = | Images.Rgb24 i -> i | Images.Index16 i -> Index16.to_rgb24 i | Images.Rgba32 i -> Rgb24.of_rgba32 i - | Images.Cmyk32 i -> Printf.printf "Pb : Image Cmyk32 !!!\n"; flush stdout ; exit 1 + | Images.Cmyk32 _i -> Printf.printf "Pb : Image Cmyk32 !!!\n"; flush stdout ; exit 1 (* ============================================================================= *) (* = Lecture d'une image et creation d'une pixmap = *) @@ -330,7 +330,7 @@ let gtk_image_load filename win format = (pix, pixmap) in - let (pix, pixmap) = create_pixmap win w h in + let (_pix, pixmap) = create_pixmap win w h in (* Creation d'une image Rgb24 quel que soit le format d'origine *) let rgb = gtk_image_rgb24_of_image image in diff --git a/sw/lib/ocaml/gtk_tools.ml b/sw/lib/ocaml/gtk_tools.ml index 2b5edf626a..3c0207abc6 100644 --- a/sw/lib/ocaml/gtk_tools.ml +++ b/sw/lib/ocaml/gtk_tools.ml @@ -1138,7 +1138,7 @@ let set_window_position window (x, y) = (* = callback = le callback a appeler = *) (* ============================================================================= *) let window_modify_connect window callback = - (window:GWindow.window)#event#connect#configure ~callback:(fun ev -> + (window:GWindow.window)#event#connect#configure ~callback:(fun _ev -> callback (get_window_geometry window) ; true) @@ -1315,9 +1315,9 @@ let scw window colors tooltips update_func vbox destroy_func = (* et un bouton de selection de couleur dont la couleur est color *) let create_boite v title color callback = let hbox = create_hbox (v:GPack.box)#pack in - let lab = create_label title hbox#pack and - but = create_color_selection_button (window:GWindow.window) - taille_x taille_y color (hbox#pack ~from:`END) callback in + let _lab = create_label title hbox#pack and + but = create_color_selection_button (window:GWindow.window) + taille_x taille_y color (hbox#pack ~from:`END) callback in but in @@ -1329,10 +1329,10 @@ let scw window colors tooltips update_func vbox destroy_func = List.iter (fun (nom, lst) -> let v = snd (create_vframe nom !vb#pack) in let do_boites (title, couleur, _) = - let b = create_boite v title !couleur - (fun color -> couleur := color; - (* Recreation de toute la liste pour mise a jour de la couleur de la boite *) - creation_liste () ; + let _b = create_boite v title !couleur + (fun color -> couleur := color; + (* Recreation de toute la liste pour mise a jour de la couleur de la boite *) + creation_liste () ; (* Application automatique ? *) if !application_auto then begin clicked_apply := true ; update_func () @@ -1463,7 +1463,7 @@ let creation_fen_capture default_filename default_format tooltips with_caption = contour_color = ref (`RGB(65535, 65535, 65535)) and back_color = ref (`RGB(0, 0, 0)) in - let (fr, hbox) = create_hframe "Legende" vbox#pack in + let (_fr, hbox) = create_hframe "Legende" vbox#pack in let entry_caption = GEdit.entry ~text:"" ~packing:hbox#add () and hb = ref (create_hbox (hbox#pack ~from:`END)) in @@ -1507,7 +1507,7 @@ let creation_fen_capture default_filename default_format tooltips with_caption = end ; (* Selection du format de sauvegarde *) - let (fr, hbox) = create_hframe "Format" vbox#pack in + let (_fr, hbox) = create_hframe "Format" vbox#pack in let lst_but = List.fold_left (fun lst typ -> let name = Gtk_image.string_of_format_capture typ in let but = @@ -1527,19 +1527,19 @@ let creation_fen_capture default_filename default_format tooltips with_caption = (* Nom du fichier *) let pm = GDraw.pixmap_from_xpm_d ~data:open_file_pixmap ~window:window () and - (fr, hbox) = create_hframe "Nom du fichier" vbox#pack in + (_fr, hbox) = create_hframe "Nom du fichier" vbox#pack in let entry = GEdit.entry ~text: !filename ~packing:hbox#add () and but_fic = create_pixbutton pm hbox#pack in (* Progression de la sauvegarde *) - let (fr, vb) = create_vframe "Sauvegarde" vbox#pack in + let (_fr, vb) = create_vframe "Sauvegarde" vbox#pack in let hbox = create_hbox vb#pack in - let l = create_label " Etat : " hbox#pack and - lab_save = create_label "" hbox#add in + let _l = create_label " Etat : " hbox#pack + and lab_save = create_label "" hbox#add in let hbox = create_hbox vb#pack in - let l = create_label " Progression : " hbox#pack and - pbar_save = GRange.progress_bar ~packing:hbox#add () in + let _l = create_label " Progression : " hbox#pack + and pbar_save = GRange.progress_bar ~packing:hbox#add () in pbar_save#set_fraction 0. ; let but_ok = create_button "Capture" window#action_area#add and @@ -1717,12 +1717,12 @@ let screenshot_box_with_caption default_filename default_format let create_int_spinner_simple label lab_width init_value min_value max_value value_width step_incr page_incr tip tooltips pack_method = let hbox = create_hbox pack_method in - let l = create_sized_label label lab_width hbox#pack and - spinner = GEdit.spin_button - ~adjustment:(GData.adjustment ~value:(float_of_int init_value) - ~lower:(float_of_int min_value) ~upper:(float_of_int max_value) - ~step_incr:(float_of_int step_incr) - ~page_incr:(float_of_int page_incr) ~page_size:0.0 ()) + let _l = create_sized_label label lab_width hbox#pack + and spinner = GEdit.spin_button + ~adjustment:(GData.adjustment ~value:(float_of_int init_value) + ~lower:(float_of_int min_value) ~upper:(float_of_int max_value) + ~step_incr:(float_of_int step_incr) + ~page_incr:(float_of_int page_incr) ~page_size:0.0 ()) ~rate:0. ~digits:0 ~width:value_width () in hbox#pack spinner#coerce ; if tip <> "" then add_tooltips tooltips spinner tip ; @@ -1836,7 +1836,7 @@ let create_hslider init_val min_val max_val step page draw_val let create_float_spinner_simple label lab_width init_value min_value max_value value_width nb_digits step_incr page_incr tip tooltips pack_method = let hbox = create_hbox pack_method in - let l = create_sized_label label lab_width hbox#pack and + let _l = create_sized_label label lab_width hbox#pack and spinner = GEdit.spin_button ~adjustment:(GData.adjustment ~value:init_value ~lower:min_value ~upper:max_value @@ -2709,7 +2709,7 @@ let display_file filename title width height tooltips font = (* = fonction prend en parametre un flottant entre 0.0 et 1.0. = *) (* = Lorsque ce flottant vaut 1.0, la fenetre est detruite = *) (* ============================================================================= *) -let create_progress_bar_win nb_blocks title = +let create_progress_bar_win title = let window = GWindow.window ~title:title ~border_width:10 ~width:200 () in let pbar = GRange.progress_bar ~packing:window#add () in (* GTK2 AAA GRange.progress_bar ~bar_style:`DISCRETE ~discrete_blocks:nb_blocks () @@ -2965,7 +2965,7 @@ let calendar lst_dates callback_select only_available_dates_selectable let current_month = ref 0 and current_year = ref 0 in if init_with_last_available_date && lst_dates<>[] then begin let d = List.hd (List.fast_sort (fun d1 d2 -> cmp_int d2 d1) lst_dates) in - let (j, m, a) = decompose_date d in current_month := m; current_year := a + let (_j, m, a) = decompose_date d in current_month := m; current_year := a end else begin let tm = timer_get_time () in current_month := (tm.Unix.tm_mon+1); current_year:= (tm.Unix.tm_year+1900) @@ -3014,7 +3014,7 @@ let calendar lst_dates callback_select only_available_dates_selectable callback_select (compose_date (i+1, !current_month, !current_year)) end) ; b) in - let buttons_shown = Array.init 31 (fun i -> false) in + let buttons_shown = Array.create 31 false in (* Mise a jour des boutons dans le calendrier *) let update_calendar () = diff --git a/sw/lib/ocaml/gtk_tools.mli b/sw/lib/ocaml/gtk_tools.mli index 2eb3f888ad..2e4e36bee3 100644 --- a/sw/lib/ocaml/gtk_tools.mli +++ b/sw/lib/ocaml/gtk_tools.mli @@ -1232,12 +1232,11 @@ val set_log_verbose_level : int -> unit (** {6 Barres de progression} *) -(** [gtk_tools_create_progress_bar_win nb_blocks title] crée une barre de progression - dans une fenetre externe. [nb_blocks] désigne le nombre de subdivisions de - la barre. En sortie, la fonction de mise à jour de la barre de progression +(** [gtk_tools_create_progress_bar_win title] crée une barre de progression + dans une fenetre externe. En sortie, la fonction de mise à jour de la barre de progression est renvoyée. Cette fonction prend en paramètre un flottant compris entre 0.0 et 1.0, lorsqu'on lui passe 1.0, la fenetre est fermée *) -val create_progress_bar_win : int -> string -> float -> unit +val create_progress_bar_win : string -> float -> unit (** [gtk_tools_create_progress_bar pack_method] creation d'une barre de progression continue et sans fenetre (donc différente de diff --git a/sw/lib/ocaml/gtk_tools_icons.mli b/sw/lib/ocaml/gtk_tools_icons.mli new file mode 100644 index 0000000000..f753496e74 --- /dev/null +++ b/sw/lib/ocaml/gtk_tools_icons.mli @@ -0,0 +1,29 @@ +(* + * $Id$ + * + * Icons library + * + * Copyright (C) 2004 CENA/ENAC, Yann Le Fablec + * + * 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. + * + *) + +val question_icon : string array +val error_icon : string array +val warning_icon : string array diff --git a/sw/lib/ocaml/latlong.ml b/sw/lib/ocaml/latlong.ml index 571a6d7873..2f03f7b977 100644 --- a/sw/lib/ocaml/latlong.ml +++ b/sw/lib/ocaml/latlong.ml @@ -179,9 +179,6 @@ let lambert_c l = let n = lambert_n l in l.r0 *. exp (l.lphi0 *. n) -let lambert = function - 1 -> lambertI | 2 -> lambertII | 3 -> lambertIII | 4 -> lambertIV | _ -> failwith "lambert";; - let of_lambert l { lbt_x = x; lbt_y = y } = let c = lambert_c l and n = lambert_n l in @@ -238,7 +235,7 @@ let utm_of geo {posn_long = lambda; posn_lat = phi} = and ys = if phi > 0. then 0. else 10000000. in let lambda_deg = truncate (floor ((Rad>>Deg)lambda)) in let zone = (lambda_deg + 180) / 6 + 1 in - let lambda_c = (Deg>>Rad) (float (lambda_deg - lambda_deg mod 6 + 3)) in + let lambda_c = (Deg>>Rad) (float (lambda_deg - ((lambda_deg mod 6)+6) mod 6 + 3)) in let e = ellipsoid.e and n = k0 *. ellipsoid.a in let ll = latitude_isometrique phi e diff --git a/sw/lib/ocaml/mapCanvas.ml b/sw/lib/ocaml/mapCanvas.ml index acdc49f7cf..61a562440b 100644 --- a/sw/lib/ocaml/mapCanvas.ml +++ b/sw/lib/ocaml/mapCanvas.ml @@ -22,7 +22,7 @@ class widget = fun ?(height=800) ?width ?wgs84_of_en () -> let canvas = GnoCanvas.canvas ~height ~packing:(frame#pack ~expand:true) () in let bottom = GPack.hbox ~height:30 ~packing:frame#pack () in - let w = GEdit.spin_button ~adjustment:adj ~rate:0. ~digits:2 ~width:50 ~height:20 ~packing:bottom#pack () in + let _w = GEdit.spin_button ~adjustment:adj ~rate:0. ~digits:2 ~width:50 ~height:20 ~packing:bottom#pack () in let lbl_xy = GMisc.label ~height:50 ~packing:bottom#pack () in @@ -158,7 +158,6 @@ class widget = fun ?(height=800) ?width ?wgs84_of_en () -> false method button_release = fun ev -> - let state = GdkEvent.Button.state ev in match GdkEvent.Button.button ev, grouping with 2, _ -> dragging <- None; false @@ -173,7 +172,6 @@ class widget = fun ?(height=800) ?width ?wgs84_of_en () -> | _ -> false method button_press = fun ev -> - let state = GdkEvent.Button.state ev in let xc = GdkEvent.Button.x ev in let yc = GdkEvent.Button.y ev in match GdkEvent.Button.button ev with diff --git a/sw/lib/ocaml/mapTrack.ml b/sw/lib/ocaml/mapTrack.ml index e58f434459..b95456f930 100644 --- a/sw/lib/ocaml/mapTrack.ml +++ b/sw/lib/ocaml/mapTrack.ml @@ -1,3 +1,29 @@ +(* + * $Id$ + * + * Track objects + * + * 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. + * + *) + open Printf module G = MapCanvas @@ -13,7 +39,7 @@ class track = fun ?(name="coucou") ?(size = 50) ?(color="red") (geomap:MapCanvas let empty = ({ G.east = 0.; north = 0. }, GnoCanvas.line group) in let aircraft = GnoCanvas.group group in - let ac_icon = + let _ac_icon = ignore (GnoCanvas.line ~fill_color:color ~props:[`WIDTH_PIXELS 4;`CAP_STYLE `ROUND] ~points:[|0.;-6.;0.;14.|] aircraft); ignore (GnoCanvas.line ~fill_color:color ~props:[`WIDTH_PIXELS 4;`CAP_STYLE `ROUND] ~points:[|-9.;0.;9.;0.|] aircraft); ignore (GnoCanvas.line ~fill_color:color ~props:[`WIDTH_PIXELS 4;`CAP_STYLE `ROUND] ~points:[|-4.;10.;4.;10.|] aircraft) in diff --git a/sw/lib/ocaml/mapWaypoints.ml b/sw/lib/ocaml/mapWaypoints.ml index 071336ef53..1b91851936 100644 --- a/sw/lib/ocaml/mapWaypoints.ml +++ b/sw/lib/ocaml/mapWaypoints.ml @@ -1,3 +1,29 @@ +(* + * $Id$ + * + * Waypoints objects + * + * 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. + * + *) + open Printf let s = 5. @@ -64,7 +90,6 @@ class waypoint = fun (group:group) (name :string) ?(alt=0.) en -> begin match ev with | `BUTTON_PRESS ev -> - let state = GdkEvent.Button.state ev in begin match GdkEvent.Button.button ev with | 1 -> self#edit diff --git a/sw/lib/ocaml/mapWaypoints.mli b/sw/lib/ocaml/mapWaypoints.mli new file mode 100644 index 0000000000..b059f9dddb --- /dev/null +++ b/sw/lib/ocaml/mapWaypoints.mli @@ -0,0 +1,66 @@ +(* + * $Id$ + * + * Waypoints objects + * + * 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. + * + *) + +class group : + ?color:string -> + ?editable:bool -> + MapCanvas.widget -> + object + method color : string + method editable : bool + method geomap : MapCanvas.widget + method group : GnoCanvas.group + end + +class waypoint : + group -> + string -> + ?alt:float -> + MapCanvas.en -> + object + val mutable alt : float + val item : GnoCanvas.polygon + val label : GnoCanvas.text + val mutable name : string + val mutable x0 : float + val mutable y0 : float + method alt : float + method delete : unit + method edit : unit + method en : MapCanvas.en + method event : GnoCanvas.item_event -> bool + method item : GnoCanvas.polygon + method label : GnoCanvas.text + method move : float -> float -> unit + method name : string + method set : MapCanvas.en -> unit + method set_name : string -> unit + method xy : float * float + method zoom : float -> unit + end + + +val waypoint : group -> ?name:string -> ?alt:float -> MapCanvas.en -> waypoint diff --git a/sw/lib/ocaml/ubx.ml b/sw/lib/ocaml/ubx.ml index a067460c8f..09b1b62719 100644 --- a/sw/lib/ocaml/ubx.ml +++ b/sw/lib/ocaml/ubx.ml @@ -73,7 +73,6 @@ let ubx_get_msg = fun ubx_class name -> let ubx_get_nav_msg = fun name -> ubx_get_msg ubx_nav name -let nav_posllh = ubx_nav_id, ubx_get_nav_msg "POSLLH" let nav_posutm = ubx_nav_id, ubx_get_nav_msg "POSUTM" let nav_status = ubx_nav_id, ubx_get_nav_msg "STATUS" let nav_velned = ubx_nav_id, ubx_get_nav_msg "VELNED" diff --git a/sw/lib/ocaml/ubx.mli b/sw/lib/ocaml/ubx.mli new file mode 100644 index 0000000000..920f7bb0e5 --- /dev/null +++ b/sw/lib/ocaml/ubx.mli @@ -0,0 +1,41 @@ +(* + * $Id$ + * + * UBX protocol handling + * + * Copyright (C) 2004 CENA/ENAC, Yann Le Fablec, 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. + * + *) + +module Protocol : + sig + val index_start : string -> int + val payload_length : string -> int -> int + val length : string -> int -> int + val payload : string -> int -> string + val uint8_t : int -> int + val ( += ) : int ref -> int -> unit + val checksum : string -> int -> string -> bool + end + +val nav_posutm : int * Xml.xml +val nav_status : int * Xml.xml +val nav_velned : int * Xml.xml +val send : out_channel -> int * Xml.xml -> (string * int) list -> unit diff --git a/sw/lib/ocaml/xml2h.mli b/sw/lib/ocaml/xml2h.mli new file mode 100644 index 0000000000..9273886c8c --- /dev/null +++ b/sw/lib/ocaml/xml2h.mli @@ -0,0 +1,35 @@ +(* + * $Id$ + * + * XML preprocessing tools + * + * Copyright (C) 2003 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. + * + *) + +exception Error of string +val nl : unit -> unit +val define : string -> string -> unit +val define_string : string -> string -> unit +val xml_error : string -> 'a +val sprint_float_array : string list -> string +val start_and_begin : string -> string -> Xml.xml +val finish : string -> unit +val warning : string -> unit