mirror of
https://github.com/paparazzi/paparazzi.git
synced 2026-06-04 22:17:01 +08:00
file splitting
This commit is contained in:
Pascal Brisset
@@ -29,20 +29,21 @@ INCLUDES=-I +lablgtk2 -I ../../lib/ocaml
|
||||
LIBS=glibivy-ocaml.cma lablgtk.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma
|
||||
CMXA=$(LIBS:.cma=.cmxa)
|
||||
|
||||
ML=horizon.ml pages.ml map2d.ml
|
||||
ML= speech.ml horizon.ml pages.ml strip.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml gcs.ml
|
||||
MAIN=gcs
|
||||
CMO=$(ML:.ml=.cmo)
|
||||
CMX=$(ML:.ml=.cmx)
|
||||
|
||||
all : map2d
|
||||
all : $(MAIN)
|
||||
|
||||
opt : map2d.opt
|
||||
opt : $(MAIN).opt
|
||||
|
||||
|
||||
map2d : $(CMO)
|
||||
$(MAIN) : $(CMO)
|
||||
@echo OL $@
|
||||
$(Q)$(OCAMLC) -custom $(INCLUDES) $(LIBS) threads.cma gtkThread.cmo gtkInit.cmo $(CMO) -o $@
|
||||
|
||||
map2d.opt : $(CMX)
|
||||
$(MAIN).opt : $(CMX)
|
||||
@echo OOL $@
|
||||
$(Q)$(OCAMLOPT) $(INCLUDES) str.cmxa unix.cmxa xml-light.cmxa $(LIBS:.cma=.cmxa) threads.cmxa gtkThread.cmx gtkInit.cmx $(CMX) -o $@
|
||||
|
||||
@@ -50,15 +51,22 @@ map2d.opt : $(CMX)
|
||||
%.cmo: %.ml ../../lib/ocaml/lib-pprz.cma ../../lib/ocaml/xlib-pprz.cma
|
||||
@echo OC $<
|
||||
$(Q)$(OCAMLC) $(INCLUDES) -c $<
|
||||
%.cmi: %.mli
|
||||
%.cmi: %.mli ../../lib/ocaml/lib-pprz.cma ../../lib/ocaml/xlib-pprz.cma
|
||||
@echo OCI $<
|
||||
$(Q)$(OCAMLC) $(INCLUDES) -c $<
|
||||
%.cmx: %.ml
|
||||
@echo OOC $<
|
||||
$(Q)$(OCAMLOPT) $(INCLUDES) -c $<
|
||||
|
||||
map2d.cmo : pages.cmi
|
||||
gcs.cmo : pages.cmi speech.cmi editFP.cmi sectors.cmi
|
||||
pages.cmo pages.cmx : pages.cmi horizon.cmi
|
||||
live.cmo : plugin.cmi live.cmi strip.cmi speech.cmi
|
||||
map2d.cmo : map2d.cmi
|
||||
strip.cmo : strip.cmi
|
||||
speech.cmo : speech.cmi
|
||||
plugin.cmo : plugin.cmi
|
||||
editFP.cmo : editFP.cmi
|
||||
sectors.cmo : sectors.cmi
|
||||
|
||||
clean:
|
||||
rm -f *~* *.cm* *.o *.out *.opt map2d
|
||||
|
||||
@@ -0,0 +1,299 @@
|
||||
(***************** Editing ONE (single) flight plan **************************)open Printf
|
||||
open Latlong
|
||||
|
||||
module G2D = Geometry_2d
|
||||
|
||||
|
||||
let (//) = Filename.concat
|
||||
let fp_example = Env.flight_plans_path // "example.xml"
|
||||
let default_path_maps = Env.paparazzi_home // "data" // "maps"
|
||||
|
||||
(** Dummy flight plan (for map calibration) *)
|
||||
let dummy_fp = fun latlong ->
|
||||
Xml.Element("flight_plan",
|
||||
["lat0", string_of_float ((Rad>>Deg)latlong.posn_lat);
|
||||
"lon0", string_of_float ((Rad>>Deg)latlong.posn_long);
|
||||
"alt", "42.";
|
||||
"MAX_DIST_FROM_HOME", "1000."],
|
||||
[Xml.Element("waypoints", [],[])])
|
||||
|
||||
|
||||
|
||||
let current_fp = ref None
|
||||
|
||||
(** Wrapper checking there is currently no flight plan loaded *)
|
||||
let if_none = fun f ->
|
||||
match !current_fp with
|
||||
Some _ ->
|
||||
GToolbox.message_box "Error" "Only one editable flight plan at a time"
|
||||
| None ->
|
||||
f ()
|
||||
|
||||
|
||||
let close_fp = fun () ->
|
||||
match !current_fp with
|
||||
None -> () (* Nothing to close *)
|
||||
| Some (fp, _filename, window) ->
|
||||
window#destroy ();
|
||||
fp#destroy ();
|
||||
current_fp := None
|
||||
|
||||
let load_xml_fp = fun geomap accel_group ?(xml_file=Env.flight_plans_path) xml ->
|
||||
Map2d.set_georef_if_none geomap (MapFP.georef_of_xml xml);
|
||||
let fp = new MapFP.flight_plan ~show_moved:false geomap "red" Env.flight_plan_dtd xml in
|
||||
let window = GWindow.window ~title:"Flight Plan" () in
|
||||
window#set_default_size ~width:700 ~height:250;
|
||||
window#add fp#window;
|
||||
window#add_accel_group accel_group;
|
||||
window#show();
|
||||
ignore (window#connect#destroy ~callback:close_fp);
|
||||
current_fp := Some (fp,xml_file, window);
|
||||
fp
|
||||
|
||||
let labelled_entry = fun ?width_chars text value h ->
|
||||
let _ = GMisc.label ~text ~packing:h#add () in
|
||||
GEdit.entry ?width_chars ~text:value ~packing:h#add ()
|
||||
|
||||
let new_fp = fun geomap accel_group () ->
|
||||
if_none (fun () ->
|
||||
let dialog = GWindow.window ~border_width:10 ~title:"New flight plan" () in
|
||||
let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in
|
||||
let h = GPack.hbox ~packing:dvbx#pack () in
|
||||
let default_latlong =
|
||||
match geomap#georef with
|
||||
None -> "WGS84 37.21098 -113.45678"
|
||||
| Some geo -> Latlong.string_of geo in
|
||||
let latlong = labelled_entry ~width_chars:25 "Geographic Reference" default_latlong h in
|
||||
let alt0 = labelled_entry ~width_chars:4 "Ground Alt" "380" h in
|
||||
let h = GPack.hbox ~packing:dvbx#pack () in
|
||||
let alt = labelled_entry ~width_chars:4 "Default Alt" "430" h in
|
||||
let qfu = labelled_entry ~width_chars:4 "QFU" "270" h in
|
||||
let mdfh = labelled_entry ~width_chars:4 "Max distance from HOME" "500" h in
|
||||
|
||||
let h = GPack.hbox ~packing:dvbx#pack () in
|
||||
let name = labelled_entry "Name" "Test flight" h in
|
||||
|
||||
let h = GPack.hbox ~packing:dvbx#pack () in
|
||||
let cancel = GButton.button ~stock:`CANCEL ~packing: h#add () in
|
||||
ignore(cancel#connect#clicked ~callback:dialog#destroy);
|
||||
|
||||
let createfp = GButton.button ~stock:`OK ~packing: h#add () in
|
||||
createfp#grab_default ();
|
||||
ignore(createfp#connect#clicked ~callback:
|
||||
begin fun _ ->
|
||||
let xml = Xml.parse_file fp_example in
|
||||
let s = ExtXml.subst_attrib in
|
||||
let wgs84 = Latlong.of_string latlong#text in
|
||||
let xml = s "lat0" (deg_string_of_rad wgs84.posn_lat) xml in
|
||||
let xml = s "lon0" (deg_string_of_rad wgs84.posn_long) xml in
|
||||
let xml = s "ground_alt" alt0#text xml in
|
||||
let xml = s "qfu" qfu#text xml in
|
||||
let xml = s "alt" alt#text xml in
|
||||
let xml = s "max_dist_from_home" mdfh#text xml in
|
||||
let xml = s "name" name#text xml in
|
||||
ignore (load_xml_fp geomap accel_group xml);
|
||||
dialog#destroy ()
|
||||
end);
|
||||
dialog#show ())
|
||||
|
||||
|
||||
(** Loading a flight plan for edition *)
|
||||
let load_fp = fun geomap accel_group () ->
|
||||
if_none (fun () ->
|
||||
match GToolbox.select_file ~title:"Open flight plan" ~filename:(Env.flight_plans_path // "*.xml") () with
|
||||
None -> ()
|
||||
| Some xml_file ->
|
||||
try
|
||||
let xml = Xml.parse_file xml_file in
|
||||
ignore (load_xml_fp geomap accel_group ~xml_file xml)
|
||||
with
|
||||
Dtd.Check_error(e) ->
|
||||
let m = sprintf "Error while loading %s:\n%s" xml_file (Dtd.check_error e) in
|
||||
GToolbox.message_box "Error" m)
|
||||
|
||||
let create_wp = fun geo ->
|
||||
match !current_fp with
|
||||
None ->
|
||||
GToolbox.message_box "Error" "Load a flight plan first";
|
||||
failwith "create_wp"
|
||||
| Some (fp,_,_) ->
|
||||
fp#add_waypoint geo
|
||||
|
||||
|
||||
let save_fp = fun () ->
|
||||
match !current_fp with
|
||||
None -> () (* Nothing to save *)
|
||||
| Some (fp, filename,_) ->
|
||||
match GToolbox.select_file ~title:"Save Flight Plan" ~filename () with
|
||||
None -> ()
|
||||
| Some file ->
|
||||
let f = open_out file in
|
||||
fprintf f "%s\n" (Xml.to_string_fmt fp#xml);
|
||||
close_out f
|
||||
|
||||
let ref_point_of_waypoint = fun xml ->
|
||||
Xml.Element("point", ["x",Xml.attrib xml "x";
|
||||
"y",Xml.attrib xml "y";
|
||||
"geo", Xml.attrib xml "name"],[])
|
||||
|
||||
|
||||
(** Calibration of chosen image (requires a dummy flight plan) *)
|
||||
let calibrate_map = fun (geomap:MapCanvas.widget) accel_group () ->
|
||||
match !current_fp with
|
||||
| Some (_fp,_,_) -> GToolbox.message_box "Error" "Close current flight plan before calibration"
|
||||
| None ->
|
||||
match GToolbox.select_file ~filename:default_path_maps ~title:"Open Image" () with
|
||||
None -> ()
|
||||
| Some image ->
|
||||
(** Displaying the image in the NW corner *)
|
||||
let pixbuf = GdkPixbuf.from_file image in
|
||||
let pix = GnoCanvas.pixbuf ~pixbuf ~props:[`ANCHOR `NW] geomap#canvas#root in
|
||||
let (x0, y0) = geomap#canvas#get_scroll_offsets in
|
||||
let (x,y) = geomap#canvas#window_to_world (float x0) (float y0) in
|
||||
pix#move x y;
|
||||
|
||||
(** Open a dummy flight plan *)
|
||||
let dummy_georef =
|
||||
match geomap#georef with
|
||||
None -> {posn_lat = (Deg>>Rad)43.; posn_long = (Deg>>Rad)1. }
|
||||
| Some geo -> geo in
|
||||
let fp_xml = dummy_fp dummy_georef in
|
||||
let fp = load_xml_fp geomap accel_group fp_xml in
|
||||
|
||||
(** Dialog to finish calibration *)
|
||||
let dialog = GWindow.window ~border_width:10 ~title:"Map calibration" () in
|
||||
let v = GPack.vbox ~packing:dialog#add () in
|
||||
let _ = GMisc.label ~text:"Choose 2 (or more) waypoints (Ctrl-Left)\nRename the waypoints with their geographic coordinates\nFor example: 'WGS84 43.123456 1.234567' or 'UTM 530134 3987652 12' or 'LBT2e 123456 543210'\nClick the button below to save the XML result file\n" ~packing:v#add () in
|
||||
let h = GPack.hbox ~packing:v#pack () in
|
||||
let cancel = GButton.button ~stock:`CLOSE ~packing:h#add () in
|
||||
let cal = GButton.button ~stock:`OK ~packing:h#add () in
|
||||
let destroy = fun () ->
|
||||
dialog#destroy ();
|
||||
close_fp ();
|
||||
pix#destroy () in
|
||||
ignore(cancel#connect#clicked ~callback:destroy);
|
||||
ignore(cal#connect#clicked ~callback:(fun _ ->
|
||||
let points = List.map XmlEdit.xml_of_node fp#waypoints in
|
||||
let points = List.map ref_point_of_waypoint points in
|
||||
let xml = Xml.Element ("map",
|
||||
["file", Filename.basename image;
|
||||
"projection", geomap#projection],
|
||||
points) in
|
||||
match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save calibrated map" () with
|
||||
None -> ()
|
||||
| Some xml_file ->
|
||||
let f = open_out xml_file in
|
||||
Printf.fprintf f "%s\n" (Xml.to_string_fmt xml);
|
||||
close_out f));
|
||||
cal#grab_default ();
|
||||
dialog#show ()
|
||||
|
||||
let radius = ref 30.
|
||||
let path = ref (ref [])
|
||||
let cur_arc = ref None
|
||||
and cur_seg = ref None
|
||||
and cur_f = ref { G2D.x2D = 0.; y2D = 0. }
|
||||
|
||||
let set_segment = fun s p1 p2 ->
|
||||
let x1 = p1.G2D.x2D and y1 = p1.G2D.y2D
|
||||
and x2 = p2.G2D.x2D and y2 = p2.G2D.y2D in
|
||||
s#set [`POINTS [|x1;y1;x2;y2|]]
|
||||
|
||||
let arc_from_points = fun (geomap:MapCanvas.widget) c l f s ->
|
||||
let cl = G2D.vect_make c l
|
||||
and cf = G2D.vect_make c f in
|
||||
let pol_cl = G2D.cart2polar cl in
|
||||
let al = pol_cl.G2D.theta2D
|
||||
and af = (G2D.cart2polar cf).G2D.theta2D in
|
||||
let xc = c.G2D.x2D and yc = c.G2D.y2D in
|
||||
let (a1, a2) = if s > 0. then (al, af) else (af, al) in
|
||||
geomap#arc ~nb_points:10 ~fill_color:"blue" ~width:2 (xc,yc) pol_cl.G2D.r2D a1 a2
|
||||
|
||||
(** Update path after waypoint move *)
|
||||
let update_path = fun (geomap:MapCanvas.widget) path waypoint ->
|
||||
let n = waypoint#name in
|
||||
let rec loop = function
|
||||
[] -> failwith (sprintf "update_path: %s not found" n)
|
||||
| [p] -> [p]
|
||||
| (wp, Some arc, Some seg, _f, radius)::wps ->
|
||||
let new_wps = if wp#name = waypoint#name then wps else loop wps in
|
||||
begin
|
||||
match new_wps with
|
||||
[] -> failwith "unreachable"
|
||||
| (wp1, _arc1, _seg1, f1, _r1)::new_wps' -> (* Previous *)
|
||||
let wp1_2D = geomap#pt2D_of wp1#pos
|
||||
and wp_2D = geomap#pt2D_of wp#pos in
|
||||
match new_wps' with
|
||||
[] -> (* wp is the second point: simple segment *)
|
||||
set_segment seg wp1_2D wp_2D;
|
||||
(wp, Some arc, Some seg, wp1_2D, radius)::new_wps
|
||||
| _ -> (* At least 2 points before *)
|
||||
let (c, f, s) = G2D.arc_segment f1 wp1_2D wp_2D radius in
|
||||
set_segment seg f wp_2D;
|
||||
arc#destroy ();
|
||||
let new_arc = arc_from_points geomap c wp1_2D f s in
|
||||
(wp, Some new_arc, Some seg, f, radius)::new_wps
|
||||
end
|
||||
| _ -> failwith "update_path" in
|
||||
path := loop !path
|
||||
|
||||
|
||||
|
||||
let path_button = fun (geomap:MapCanvas.widget) (xw, yw) ->
|
||||
let geo = geomap#of_world (xw, yw) in
|
||||
let wp = create_wp geo in
|
||||
let cur_path = !path in
|
||||
wp#connect (fun () -> update_path geomap cur_path wp);
|
||||
if ! !path = [] then
|
||||
cur_f := {G2D.x2D=xw; G2D.y2D=yw};
|
||||
cur_path := (wp, !cur_arc, !cur_seg, !cur_f, !radius) :: ! cur_path;
|
||||
cur_arc := Some (GnoCanvas.line geomap#canvas#root);
|
||||
cur_seg := Some (geomap#segment ~fill_color:"blue" ~width:2 geo geo)
|
||||
|
||||
let path_notify (geomap:MapCanvas.widget) (xw, yw) =
|
||||
match ! !path with
|
||||
[] -> false (** Empty path: nothing to do *)
|
||||
| (wp1, _, _, ll,_) :: p -> (** Last is wp1 *)
|
||||
begin
|
||||
match !cur_seg with
|
||||
None -> failwith "path_notify"
|
||||
| Some segment ->
|
||||
let l = geomap#pt2D_of wp1#pos
|
||||
and cur_2D = {G2D.x2D = xw; y2D = yw } in
|
||||
match p with
|
||||
[] -> (** Only 1 point in the current path:add a simple segment*)
|
||||
set_segment segment l cur_2D;
|
||||
| _::_ -> (** Already 2 points: add an arc and a segment *)
|
||||
match !cur_arc with
|
||||
None -> failwith "path_notify"
|
||||
| Some arc ->
|
||||
arc#destroy ();
|
||||
let (c, f, s) = G2D.arc_segment ll l cur_2D !radius in
|
||||
set_segment segment f cur_2D;
|
||||
let arc = arc_from_points geomap c l f s in
|
||||
cur_arc := Some arc;
|
||||
cur_f := f
|
||||
end;
|
||||
true
|
||||
|
||||
|
||||
let path_close = fun () ->
|
||||
let destroy = fun ref ->
|
||||
match !ref with
|
||||
None -> ()
|
||||
| Some s -> s#destroy (); ref := None in
|
||||
destroy cur_arc;
|
||||
destroy cur_seg;
|
||||
begin
|
||||
match !current_fp with
|
||||
None -> ()
|
||||
| Some (fp, _,_) ->
|
||||
fp#insert_path (List.map (fun (wp,_,_,_,r) -> (wp, r)) (List.rev ! !path));
|
||||
end;
|
||||
path := ref []
|
||||
|
||||
let path_change_radius = function
|
||||
`UP -> radius := !radius *. 1.1
|
||||
| `DOWN -> radius := !radius /. 1.1
|
||||
| _ -> ()
|
||||
|
||||
@@ -0,0 +1,11 @@
|
||||
val path_button :
|
||||
MapCanvas.widget -> MapCanvas.LL.fmeter * MapCanvas.LL.fmeter -> unit
|
||||
val path_notify : MapCanvas.widget -> float * float -> bool
|
||||
val path_close : unit -> unit
|
||||
val path_change_radius : [> `DOWN | `UP ] -> unit
|
||||
val create_wp : MapCanvas.LL.geographic -> MapWaypoints.waypoint
|
||||
val calibrate_map : MapCanvas.widget -> Gtk.accel_group -> unit -> unit
|
||||
val new_fp : MapCanvas.widget -> Gtk.accel_group -> unit -> unit
|
||||
val load_fp : MapCanvas.widget -> Gtk.accel_group -> unit -> unit
|
||||
val save_fp : unit -> unit
|
||||
val close_fp : unit -> unit
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,15 @@
|
||||
val message_request : string -> string -> Pprz.values -> (string -> Pprz.values -> unit) -> unit
|
||||
|
||||
val aircrafts_msg : MapCanvas.widget -> GPack.notebook -> Pprz.values -> unit
|
||||
val safe_bind : string -> (string -> Pprz.values -> unit) -> unit
|
||||
val one_new_ac : MapCanvas.widget -> GPack.notebook -> string -> unit
|
||||
val listen_flight_params :
|
||||
< center : MapCanvas.LL.geographic -> unit; .. > -> bool -> unit
|
||||
val listen_wind_msg : unit -> unit
|
||||
val listen_fbw_msg : unit -> unit
|
||||
val listen_engine_status_msg : unit -> unit
|
||||
val listen_if_calib_msg : unit -> unit
|
||||
val listen_waypoint_moved : unit -> unit
|
||||
val listen_infrared : unit -> unit
|
||||
val listen_svsinfo : unit -> unit
|
||||
val listen_alert : < add : string -> unit; .. > -> unit
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,25 @@
|
||||
(*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright (C) 2004-2006 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.
|
||||
*
|
||||
*)
|
||||
|
||||
val set_georef_if_none : MapCanvas.widget -> Latlong.geographic -> unit
|
||||
@@ -0,0 +1 @@
|
||||
let frame = ref (None: GBin.event_box option)
|
||||
@@ -0,0 +1 @@
|
||||
val frame : GBin.event_box option ref
|
||||
@@ -0,0 +1,41 @@
|
||||
(******** Sectors **********************************************************)
|
||||
|
||||
open Printf
|
||||
|
||||
let (//) = Filename.concat
|
||||
|
||||
let rec display = fun (geomap:MapCanvas.widget) r ->
|
||||
|
||||
match String.lowercase (Xml.tag r) with
|
||||
"disc" ->
|
||||
let rad = float_of_string (ExtXml.attrib r "radius")
|
||||
and geo = Latlong.of_string (ExtXml.attrib (ExtXml.child r "point") "pos") in
|
||||
ignore (geomap#circle ~width:5 ~color:"red" geo rad)
|
||||
| "union" ->
|
||||
List.iter (display geomap) (Xml.children r)
|
||||
| "polygon" ->
|
||||
let pts = List.map (fun x -> Latlong.of_string (ExtXml.attrib x "pos")) (Xml.children r) in
|
||||
let pts = Array.of_list pts in
|
||||
let n = Array.length pts in
|
||||
for i = 0 to n - 1 do
|
||||
ignore (geomap#segment ~width:5 ~fill_color:"red" pts.(i) pts.((i+1)mod n))
|
||||
done
|
||||
|x -> fprintf stderr "Sector.display: '%s' not yet\n%!" x
|
||||
|
||||
|
||||
let display_sector = fun (geomap:MapCanvas.widget) sector ->
|
||||
display geomap (ExtXml.child sector "0")
|
||||
|
||||
|
||||
let load = fun geomap () ->
|
||||
match GToolbox.select_file ~title:"Load sectors" ~filename:(Env.flight_plans_path // "*.xml") () with
|
||||
None -> ()
|
||||
| Some f ->
|
||||
try
|
||||
let xml = Xml.parse_file f in
|
||||
List.iter (display_sector geomap) (Xml.children xml)
|
||||
with
|
||||
Dtd.Prove_error(e) ->
|
||||
let m = sprintf "Error while loading %s:\n%s" f (Dtd.prove_error e) in
|
||||
GToolbox.message_box "Error" m
|
||||
|
||||
@@ -0,0 +1 @@
|
||||
val load : MapCanvas.widget -> unit -> unit
|
||||
@@ -0,0 +1,5 @@
|
||||
let active = ref false
|
||||
|
||||
let say = fun s ->
|
||||
if !active then
|
||||
ignore (Sys.command (Printf.sprintf "spd-say '%s'&" s))
|
||||
@@ -0,0 +1,2 @@
|
||||
val active : bool ref
|
||||
val say : string -> unit
|
||||
@@ -0,0 +1,103 @@
|
||||
(************ Strip handling ***********************************************)
|
||||
|
||||
let bat_max = 13.
|
||||
let bat_min = 8.
|
||||
|
||||
(** window for the strip panel *)
|
||||
let scrolled = GBin.scrolled_window ~width:300 ~hpolicy: `AUTOMATIC ~vpolicy: `AUTOMATIC ()
|
||||
let table = GPack.table ~rows: 1 ~columns: 1 ~row_spacings: 5 ~packing: (scrolled#add_with_viewport) ()
|
||||
|
||||
|
||||
type t = {
|
||||
gauge: GRange.progress_bar ;
|
||||
labels: (string * (GBin.event_box * GMisc.label)) list
|
||||
}
|
||||
|
||||
let labels_name = [|
|
||||
[| "AP" ; "alt" ; "->" |]; [| "RC"; "climb"; "/" |]; [| "GPS"; "speed"; "" |];
|
||||
[| "settings" ; "throttle"; "" |]
|
||||
|]
|
||||
|
||||
let labels_print = [|
|
||||
[| "AP" ; "alt" ; "->" |]; [| "RC"; "climb"; "->" |]; [| "GPS"; "speed"; "" |];
|
||||
[| "CAL" ; "throttle"; "" |]
|
||||
|]
|
||||
let gen_int = let i = ref (-1) in fun () -> incr i; !i
|
||||
|
||||
let rows = Array.length labels_name + 1
|
||||
|
||||
|
||||
(** add a strip to the panel *)
|
||||
let add config color select center_ac commit_moves mark =
|
||||
let widget = table in
|
||||
(* number of the strip *)
|
||||
let strip_number = gen_int () in
|
||||
if strip_number > 1 then widget#set_rows strip_number;
|
||||
|
||||
let strip_labels = ref [] in
|
||||
let add_label = fun name value ->
|
||||
strip_labels := (name, value) :: !strip_labels in
|
||||
|
||||
let ac_name = Pprz.string_assoc "ac_name" config in
|
||||
|
||||
(* frame of the strip *)
|
||||
let frame = GBin.frame ~shadow_type: `IN ~packing: (widget#attach ~top: (strip_number) ~left: 0) () in
|
||||
let strip = GPack.table ~rows: 2 ~columns: 2 ~col_spacings: 10 ~packing: frame#add () in
|
||||
ignore (GMisc.label ~text: (ac_name) ~packing: (strip#attach ~top: 0 ~left: 0) ());
|
||||
|
||||
let plane_color = GBin.event_box ~width:10 ~height:10 ~packing:(strip#attach ~top:0 ~left: 1) () in
|
||||
plane_color#coerce#misc#modify_bg [`NORMAL, `NAME color];
|
||||
ignore (plane_color#event#connect#button_press ~callback:(fun _ -> select (); true));
|
||||
let h = GPack.hbox ~packing:plane_color#add () in
|
||||
let ft = GMisc.label ~text: "00:00:00" ~packing:h#add () in
|
||||
ft#set_width_chars 8;
|
||||
add_label ("flight_time_value") (plane_color, ft);
|
||||
let block_name = GMisc.label ~text: "______" ~packing:h#add () in
|
||||
add_label ("block_name_value") (plane_color, block_name);
|
||||
|
||||
|
||||
(* battery and flight time *)
|
||||
let pb = GRange.progress_bar ~orientation: `BOTTOM_TO_TOP ~packing:(strip#attach ~top:1 ~left:0) () in
|
||||
pb#coerce#misc#modify_fg [`PRELIGHT, `NAME "green"];
|
||||
pb#coerce#misc#modify_font_by_name "sans 12";
|
||||
|
||||
let left_box = GPack.table ~rows ~columns: 6 ~col_spacings: 5
|
||||
~packing: (strip#attach ~top: 1 ~left: 1) () in
|
||||
|
||||
Array.iteri
|
||||
(fun i a ->
|
||||
Array.iteri
|
||||
(fun j s ->
|
||||
ignore (GMisc.label ~text: labels_print.(i).(j) ~justify:`RIGHT ~packing: (left_box#attach ~top: i ~left: (2*j)) ());
|
||||
let eb = GBin.event_box ~packing: (left_box#attach ~top: i ~left: (2*j+1)) () in
|
||||
let lvalue = (GMisc.label ~text: "" ~justify: `RIGHT ~packing:eb#add ()) in
|
||||
lvalue#set_width_chars 6;
|
||||
add_label (s^"_value") (eb, lvalue);
|
||||
) a
|
||||
) labels_name;
|
||||
let b = GButton.button ~label:"Center A/C" ~packing:(left_box#attach ~top:4 ~left:0 ~right:2) () in
|
||||
ignore(b#connect#clicked ~callback:center_ac);
|
||||
let b = GButton.button ~label:"Commit WPs" ~packing:(left_box#attach ~top:4 ~left:2 ~right:4) () in
|
||||
ignore (b#connect#clicked ~callback:commit_moves);
|
||||
let b = GButton.button ~label:"Mark" ~packing:(left_box#attach ~top:4 ~left:4 ~right:6) () in
|
||||
ignore (b#connect#clicked ~callback:mark);
|
||||
{gauge=pb ; labels= !strip_labels}
|
||||
|
||||
|
||||
(** set a label *)
|
||||
let set_label strip name value =
|
||||
let _eb, l = List.assoc (name^"_value") strip.labels in
|
||||
l#set_label value
|
||||
|
||||
(** set a label *)
|
||||
let set_color strip name color =
|
||||
let eb, _l = List.assoc (name^"_value") strip.labels in
|
||||
eb#coerce#misc#modify_bg [`NORMAL, `NAME color]
|
||||
|
||||
(** set the battery *)
|
||||
let set_bat strip value =
|
||||
strip.gauge#set_text (string_of_float value);
|
||||
let f = (value -. bat_min) /. (bat_max -. bat_min) in
|
||||
let f = max 0. (min 1. f) in
|
||||
strip.gauge#set_fraction f
|
||||
|
||||
@@ -0,0 +1,9 @@
|
||||
type t
|
||||
val add :
|
||||
Pprz.values ->
|
||||
string ->
|
||||
(unit -> 'a) -> (unit -> unit) -> (unit -> unit) -> (unit -> unit) -> t
|
||||
val set_label : t -> string -> string -> unit
|
||||
val set_color : t -> string -> string -> unit
|
||||
val set_bat : t -> float -> unit
|
||||
val scrolled : GBin.scrolled_window
|
||||
Reference in New Issue
Block a user