misc improvements

This commit is contained in:
Pascal Brisset
2006-06-18 20:35:27 +00:00
parent c3c5faea39
commit 4dda70aed8
4 changed files with 114 additions and 87 deletions
+47 -36
View File
@@ -37,6 +37,14 @@ let pvect (x1,y1) (x2,y2) = x1*.y2-.y1*.x2
let angle (x1,y1) (x2,y2) (x3,y3) =
pvect (x3-.x2, y3-.y2) (x1-.x2,y1-.y2)
let rec list_iter3 = fun f l1 l2 l3 ->
match l1, l2, l3 with
[], [], [] -> ()
| x1::x1s, x2::x2s, x3::x3s ->
f x1 x2 x3;
list_iter3 f x1s x2s x3s
| _ -> invalid_arg "list_iter3"
let rec n_first n = function
[] -> []
| x::xs -> if n > 0 then x::n_first (n-1) xs else []
@@ -869,7 +877,7 @@ module Live = struct
fp#waypoints
let create_ac = fun (geomap:G.widget) (fp_notebook:GPack.notebook) ac_id config ->
let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) ac_id config ->
let color = Pprz.string_assoc "default_gui_color" config
and name = Pprz.string_assoc "ac_name" config in
@@ -920,16 +928,29 @@ module Live = struct
let params = ac_menu_fact#add_check_item "flight param. display" ~active:false in
ignore (params#connect#toggled (fun () -> track#set_params_state params#active));
(** Build the XML flight plan, connect then "jump_to_block" *)
let fp_xml = ExtXml.child fp_xml_dump "flight_plan" in
let fp = load_mission ~edit:false color geomap fp_xml in
fp#connect_activated (fun node ->
if XmlEdit.tag node = "block" then
let block = XmlEdit.attrib node "name" in
let id = list_casso block blocks in
jump_to_block ac_id id);
ignore (reset_wp_menu#connect#activate (reset_waypoints fp));
(** Add a new tab in the A/Cs notebook, with a colored label *)
let eb = GBin.event_box () in
let label = GMisc.label ~text:name ~packing:eb#add () in
eb#coerce#misc#modify_bg [`NORMAL, `NAME color;`ACTIVE, `NAME color];
let ac_frame = GBin.frame ~packing: ((fp_notebook:GPack.notebook)#append_page ~tab_label:eb#coerce)() in
(** Put a notebook for this A/C *)
let ac_frame = GBin.frame ~packing:(acs_notebook#append_page ~tab_label:eb#coerce) () in
let ac_notebook = GPack.notebook ~packing: ac_frame#add () in
let visible = fun w ->
ac_notebook#page_num w#coerce = ac_notebook#current_page in
(** Insert the flight plan tab *)
let fp_label = GMisc.label ~text: "Flight Plan" () in
(ac_notebook:GPack.notebook)#append_page ~tab_label:fp_label#coerce fp#window#coerce;
@@ -941,12 +962,13 @@ module Live = struct
let gps_label = GMisc.label ~text: "GPS" () in
let gps_frame = GBin.frame ~shadow_type: `NONE
~packing: (ac_notebook#append_page ~tab_label: gps_label#coerce) () in
let gps_page = new Pages.gps gps_frame in
let gps_page = new Pages.gps ~visible gps_frame in
let pfd_label = GMisc.label ~text: "PFD" () in
let pfd_frame = GBin.frame ~shadow_type: `NONE
~packing: (ac_notebook#append_page ~tab_label: pfd_label#coerce) () in
let pfd_page = new Pages.pfd pfd_frame in
let pfd_page = new Pages.pfd pfd_frame
and pfd_page_num = ac_notebook#page_num pfd_frame#coerce in
let misc_label = GMisc.label ~text: "Misc" () in
let misc_frame = GBin.frame ~shadow_type: `NONE
@@ -959,25 +981,20 @@ module Live = struct
let callback = fun idx value ->
let vs = ["ac_id", Pprz.String ac_id; "index", Pprz.Int idx;"value", Pprz.Float value] in
Ground_Pprz.message_send "dl" "DL_SETTING" vs in
let settings_tab = new Pages.settings xml_settings callback in
let settings_tab = new Pages.settings ~visible xml_settings callback in
let tab_label = (GMisc.label ~text:"Settings" ())#coerce in
ac_notebook#append_page ~tab_label settings_tab#widget;
Some settings_tab
with
_ -> None in
fp#connect_activated (fun node ->
if XmlEdit.tag node = "block" then
let block = XmlEdit.attrib node "name" in
let id = list_casso block blocks in
jump_to_block ac_id id);
ignore (reset_wp_menu#connect#activate (reset_waypoints fp));
(** Add a strip and connect it to the A/C notebook *)
let select_this_tab =
let n = fp_notebook#page_num ac_frame#coerce in
fun () -> fp_notebook#goto_page n in
let n = acs_notebook#page_num ac_frame#coerce in
fun () -> acs_notebook#goto_page n in
let strip = Strip.add strip_table config color select_this_tab center_ac commit_moves in
Hashtbl.add live_aircrafts ac_id { track = track; color = color;
fp_group = fp ; config = config ;
fp = fp_xml; ac_name = name;
@@ -1090,8 +1107,7 @@ module Live = struct
let ac = get_ac vs in
let pfd_page = ac.pfd_page in
pfd_page#set_roll (Pprz.float_assoc "roll" vs);
pfd_page#set_pitch (Pprz.float_assoc "pitch" vs);
pfd_page#set_attitude (Pprz.float_assoc "roll" vs) (Pprz.float_assoc "pitch" vs);
pfd_page#set_alt (Pprz.float_assoc "alt" vs);
pfd_page#set_climb (Pprz.float_assoc "climb" vs);
pfd_page#set_speed (Pprz.float_assoc "speed" vs);
@@ -1151,8 +1167,7 @@ module Live = struct
safe_bind "CAM_STATUS" get_cam_status;
let get_circle_status = fun _sender vs ->
let ac_id = Pprz.string_assoc "ac_id" vs in
let ac = Hashtbl.find live_aircrafts ac_id in
let ac = get_ac vs in
let a = fun s -> Pprz.float_assoc s vs in
let wgs84 = { posn_lat = (Deg>>Rad)(a "circle_lat"); posn_long = (Deg>>Rad)(a "circle_long") } in
circle_status_msg ac.track wgs84 (float_of_string (Pprz.string_assoc "radius" vs))
@@ -1204,20 +1219,18 @@ module Live = struct
let listen_waypoint_moved = fun () ->
let get_values = fun _sender vs ->
let ac_id = Pprz.string_assoc "ac_id" vs in
let ac = Hashtbl.find live_aircrafts ac_id in
(** Not_found catched by safe_bind *)
let ac = get_ac vs in
let wp_id = Pprz.int_assoc "wp_id" vs in
let a = fun s -> Pprz.float_assoc s vs in
let geo = { posn_lat = (Deg>>Rad)(a "lat"); posn_long = (Deg>>Rad)(a "long") }
and altitude = a "alt" in
(** No indexed access to waypoints: iter and compare: *)
(** FIXME: No indexed access to waypoints: iter and compare: *)
List.iter (fun w ->
let (i, w) = ac.fp_group#index w in
if i = wp_id then begin
w#set ~if_not_moved:true ~altitude ~update:true geo;
raise Exit (** catched by safe_bind *)
raise Exit (** catched by safe_bind *)
end)
ac.fp_group#waypoints
in
@@ -1258,16 +1271,14 @@ module Live = struct
let ac_id = Pprz.string_assoc "ac_id" vs in
let ac = Hashtbl.find live_aircrafts ac_id in
let gps_page = ac.gps_page in
let svid = Array.of_list
(Str.split (Str.regexp ",") (Pprz.string_assoc "svid" vs)) in
let cno = Array.of_list
(Str.split (Str.regexp ",") (Pprz.string_assoc "cno" vs)) in
let flags = Array.of_list
(Str.split (Str.regexp ",") (Pprz.string_assoc "flags" vs)) in
Array.iteri (fun i id ->
if id<>"0" then
gps_page#svsinfo id cno.(i) (int_of_string flags.(i))) svid
let svid = Str.split list_separator (Pprz.string_assoc "svid" vs)
and cn0 = Str.split list_separator (Pprz.string_assoc "cno" vs)
and flags = Str.split list_separator (Pprz.string_assoc "flags" vs) in
list_iter3
(fun id cno flags ->
if id <> "0" then gps_page#svsinfo id cno (int_of_string flags))
svid cn0 flags
let listen_svsinfo = fun () -> safe_bind "SVSINFO" get_svsinfo
end (** module Live *)
+22 -37
View File
@@ -78,7 +78,7 @@ end
(*****************************************************************************)
(* gps page *)
(*****************************************************************************)
class gps (widget: GBin.frame) =
class gps ?(visible = fun _ -> true) (widget: GBin.frame) =
let table = GPack.table
~rows: 1
~columns: 3
@@ -96,8 +96,7 @@ object (this)
val mutable active_flags = []
method svsinfo svid cno flags =
if not (List.mem_assoc svid active_cno)
then begin
if not (List.mem_assoc svid active_cno) then
let rows = table#rows in
let _svid_label = GMisc.label
~text: ("sat "^ svid) ~packing: (table#attach ~top: rows ~left: 0) () in
@@ -109,34 +108,26 @@ object (this)
active_cno <- (svid, cno_label)::active_cno;
active_flags <- (svid, flags_eb)::active_flags;
table#set_rows (table#rows +1)
end
else begin
else if visible widget then
let cno_label = List.assoc svid active_cno in
let flags_eb = List.assoc svid active_flags in
cno_label#set_label (cno^" dB Hz");
update_color flags_eb flags
end
end
(*****************************************************************************)
(* pfd page *)
(*****************************************************************************)
class pfd (widget: GBin.frame) =
class pfd ?(visible = fun _ -> true) (widget: GBin.frame) =
let horizon = new Horizon.h ~packing: widget#add 150 in
let _lazy = fun f x -> if visible widget then f x in
object (this)
val mutable pitch = 0.
val mutable roll = 0.
method set_roll r =
roll <- r;
horizon#set_attitude ((Deg>>Rad)roll) ((Deg>>Rad)pitch)
method set_pitch p =
pitch <- p;
horizon#set_attitude ((Deg>>Rad)roll) ((Deg>>Rad)pitch)
method set_alt (a:float) = horizon#set_alt a
method set_attitude roll pitch =
_lazy (horizon#set_attitude ((Deg>>Rad)roll)) ((Deg>>Rad)pitch)
method set_alt (a:float) = _lazy horizon#set_alt a
method set_climb (c:float) = ()
method set_speed (c:float) = horizon#set_speed c
method set_speed (c:float) = _lazy horizon#set_speed c
end
@@ -165,15 +156,13 @@ class misc ~packing (widget: GBin.frame) =
(*****************************************************************************)
(* Dataling settings paged *)
(*****************************************************************************)
class settings = fun xml_settings callback ->
class settings = fun ?(visible = fun _ -> true) xml_settings callback ->
let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
let vbox = GPack.vbox ~packing:sw#add_with_viewport () in
let n = List.length xml_settings in
let current_values = Array.create n 42. in
let i = ref 0 in
let _ =
List.iter
(fun s ->
let current_values =
Array.mapi
(fun i s ->
let f = fun a -> float_of_string (ExtXml.attrib s a) in
let lower = f "min"
and upper = f "max"
@@ -185,26 +174,22 @@ class settings = fun xml_settings callback ->
let _l = GMisc.label ~width:100 ~text ~packing:hbox#pack () in
let _v = GMisc.label ~width:50 ~text:"N/A" ~packing:hbox#pack () in
let _scale = GRange.scale `HORIZONTAL ~digits:2 ~adjustment:adj ~packing:hbox#add () in
let ii = !i in
let update_current_value = fun _ ->
let s = string_of_float current_values.(ii) in
if _v#text <> s then
_v#set_text s;
true in
ignore (Glib.Timeout.add 500 update_current_value);
let callback = fun _ -> callback ii adj#value in
let callback = fun _ -> callback i adj#value in
let b = GButton.button ~label:"Commit" ~stock:`APPLY ~packing:hbox#pack () in
ignore (b#connect#clicked ~callback);
incr i
_v
)
xml_settings in
object
(Array.of_list xml_settings) in
object (self)
method length = n
method widget = sw#coerce
method set = fun i v -> current_values.(i) <- v
method set = fun i v ->
if visible self#widget then
let s = string_of_float v in
if current_values.(i)#text <> s then
current_values.(i)#set_text s
end
+7 -5
View File
@@ -9,24 +9,26 @@ class infrared : GBin.frame ->
method set_gps_hybrid_factor : float -> unit
method set_gps_hybrid_mode : string -> unit
end
class gps : GBin.frame ->
class gps : ?visible:(GBin.frame -> bool) -> GBin.frame ->
object
method svsinfo : string -> string -> int -> unit
end
class pfd : GBin.frame ->
class pfd : ?visible:(GBin.frame -> bool) -> GBin.frame ->
object
method set_speed : float -> unit
method set_alt : float -> unit
method set_climb : float -> unit
method set_pitch : float -> unit
method set_roll : float -> unit
method set_attitude : float -> float -> unit
end
class settings : Xml.xml list -> (int -> float -> unit) ->
class settings : ?visible:(GObj.widget -> bool) -> Xml.xml list -> (int -> float -> unit) ->
object
method length : int
method set : int -> float -> unit
method widget : GObj.widget
end
class misc :
packing:(GObj.widget -> unit) ->
GBin.frame ->
+38 -9
View File
@@ -47,6 +47,11 @@ let rec norm_angle_360 = fun alpha ->
let cam_half_aperture = LL.pi /. 6.0
let half_pi = LL.pi /. 2.0
type desired =
NoDesired
| DesiredCircle of LL.geographic*float*GnoCanvas.ellipse
| DesiredSegment of LL.geographic*LL.geographic*GnoCanvas.line
class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanvas.widget) ->
let group = GnoCanvas.group geomap#canvas#root in
@@ -82,6 +87,9 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
let min_distance_scaled = 10. in
let min_height_scaled = 0.1 in
let desired_circle = GnoCanvas.ellipse group
and desired_segment = GnoCanvas.line group in
let top = ref 0 in
object (self)
@@ -101,8 +109,8 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
val mutable cam_on = false
val mutable params_on = false
val mutable v_params_on = false
val mutable desired_track = ((GnoCanvas.ellipse group) :> GnoCanvas.base_item)
val mutable zone = GnoCanvas.rect group
val mutable desired_track = NoDesired
val zone = GnoCanvas.rect group
val mutable ac_cam_cover = GnoCanvas.rect cam
method color = color
method set_color c = color <- c
@@ -170,19 +178,40 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
(** draws the circular path to be followed by the aircraft in circle mode *)
method draw_circle = fun en radius ->
desired_track#destroy ();
desired_track <- ((geomap#circle ~color:"green" en radius) :> GnoCanvas.base_item);
let create = fun () ->
desired_track <- DesiredCircle (en, radius, geomap#circle ~color:"green" en radius) in
match desired_track with
DesiredCircle (c, r, circle) ->
if c <> en || r <> radius then begin
circle#destroy ();
create ()
end
| DesiredSegment (p1,p2,s) ->
s#destroy ();
create ()
| NoDesired ->
create ()
(** draws the linear path to be followed by the aircraft between two waypoints *)
method draw_segment = fun en en2 ->
desired_track#destroy ();
desired_track <- ((geomap#segment ~fill_color:"green" en en2) :> GnoCanvas.base_item)
method draw_segment = fun en1 en2 ->
let create = fun () ->
desired_track <- DesiredSegment (en1, en2, geomap#segment ~fill_color:"green" en1 en2) in
match desired_track with
DesiredCircle (c, r, circle) ->
circle#destroy ();
create ()
| DesiredSegment (p1,p2,s) ->
if p1 <> en1 || p2 <> en2 then begin
s#destroy ();
create ()
end
| NoDesired ->
create ()
method draw_zone = fun geo1 geo2 ->
zone#destroy ();
let (x1, y1) = geomap#world_of geo1
and (x2, y2) = geomap#world_of geo2 in
zone <- GnoCanvas.rect ~props:[`X1 x1; `Y1 y1; `X2 x2; `Y2 y2; `OUTLINE_COLOR "#ffc0c0"; `WIDTH_PIXELS 2] geomap#canvas#root
zone#set [`X1 x1; `Y1 y1; `X2 x2; `Y2 y2; `OUTLINE_COLOR "#ffc0c0"; `WIDTH_PIXELS 2]
(** moves the rectangle representing the field covered by the camera *)
method move_cam = fun wgs84 mission_target_wgs84 ->