This commit is contained in:
Pascal Brisset
2006-08-20 19:43:00 +00:00
parent 53e8f91aee
commit 345f980793
8 changed files with 170 additions and 176 deletions
+1 -1
View File
@@ -29,7 +29,7 @@ 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= speech.ml horizon.ml strip.ml pages.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml gcs.ml
ML= horizon.ml strip.ml pages.ml speech.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml gcs.ml
MAIN=gcs
CMO=$(ML:.ml=.cmo)
CMX=$(ML:.ml=.cmx)
+1 -1
View File
@@ -568,7 +568,7 @@ let _main =
Live.safe_bind "NEW_AIRCRAFT" (fun _sender vs -> Live.one_new_ac geomap ac_notebook (Pprz.string_assoc "ac_id" vs));
(** Listen for all messages on ivy *)
Live.listen_flight_params geomap !auto_center_new_ac;
Live.listen_flight_params geomap !auto_center_new_ac my_alert;
Live.listen_wind_msg ();
Live.listen_fbw_msg ();
Live.listen_engine_status_msg ();
+56 -68
View File
@@ -44,7 +44,8 @@ type aircraft = {
rc_settings_page : Pages.rc_settings option;
strip : Strip.t;
mutable first_pos : bool;
mutable last_block_name : string
mutable last_block_name : string;
mutable in_kill_mode : bool
}
let live_aircrafts = Hashtbl.create 3
@@ -52,32 +53,14 @@ let get_ac = fun vs ->
let ac_id = Pprz.string_assoc "ac_id" vs in
Hashtbl.find live_aircrafts ac_id
let aircraft_pos_msg = fun track wgs84 heading altitude speed climb ->
let h =
try
Srtm.of_wgs84 wgs84
with
_ -> truncate altitude in
track#move_icon wgs84 heading altitude (float_of_int h) speed climb
let carrot_pos_msg = fun track wgs84 ->
track#move_carrot wgs84
let cam_pos_msg = fun track wgs84 target_wgs84 ->
track#move_cam wgs84 target_wgs84
let circle_status_msg = fun track wgs84 radius ->
track#draw_circle wgs84 radius
let segment_status_msg = fun track geo1 geo2 ->
track#draw_segment geo1 geo2
let survey_status_msg = fun track geo1 geo2 ->
track#draw_zone geo1 geo2
let ap_status_msg = fun track flight_time ->
track#update_ap_status flight_time
let log_and_say =
let last = ref "" in
fun (a:Pages.alert) s ->
if s <> !last then begin
a#add s;
Speech.say s;
last := s
end
let show_mission = fun ac on_off ->
let a = Hashtbl.find live_aircrafts ac in
@@ -373,9 +356,14 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) ac_id config
dl_settings_page = dl_settings_page;
rc_settings_page = rc_settings_page;
strip = strip; first_pos = true;
last_block_name = ""
last_block_name = "";
in_kill_mode = false
}
let ok_color = "green"
let warning_color = "orange"
let alert_color = "red"
(** Bind to message while catching all the esceptions of the callback *)
let safe_bind = fun msg cb ->
let safe_cb = fun sender vs ->
@@ -412,9 +400,8 @@ let get_fbw_msg = fun _sender vs ->
Strip.set_label ac.strip "RC" status;
Strip.set_color ac.strip "RC"
(match status with
"LOST" -> "orange"
| "REALLY_LOST" -> "red"
| _ -> "white")
"LOST" | "REALLY_LOST" -> warning_color
| _ -> ok_color)
@@ -474,38 +461,38 @@ let highlight_fp = fun ac b s ->
end
let listen_flight_params = fun geomap auto_center_new_ac ->
let listen_flight_params = fun geomap auto_center_new_ac alert ->
let get_fp = fun _sender vs ->
let ac = get_ac vs in
let pfd_page = ac.pfd_page in
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);
let a = fun s -> Pprz.float_assoc s vs in
let alt = a "alt"
and climb = a "climb"
and speed = a "speed" in
pfd_page#set_attitude (a "roll") (a "pitch");
pfd_page#set_alt alt;
pfd_page#set_climb climb;
pfd_page#set_speed speed;
let wgs84 = { posn_lat=(Deg>>Rad)(a "lat"); posn_long = (Deg>>Rad)(a "long") } in
aircraft_pos_msg ac.track wgs84 (a "course") (a "alt") (a "speed") (a "climb");
ac.track#move_icon wgs84 (a "course") alt speed climb;
if auto_center_new_ac && ac.first_pos then begin
center geomap ac.track ();
ac.first_pos <- false
end;
let set_label lbl_name field_name =
let set_label lbl_name value =
let s =
if (a field_name) < 0.
then
"- "^(sprintf "%.1f" (abs_float (a field_name)))
else
sprintf "%.1f" (a field_name)
if value < 0.
then sprintf "- %.1f" (abs_float value)
else sprintf "%.1f" value
in
Strip.set_label ac.strip lbl_name s
in
set_label "alt" "alt";
set_label "speed" "speed";
set_label "climb" "climb"
set_label "alt" alt;
set_label "speed" speed;
set_label "climb" climb
in
safe_bind "FLIGHT_PARAM" get_fp;
@@ -513,7 +500,7 @@ let listen_flight_params = fun geomap auto_center_new_ac ->
let ac = get_ac vs in
let a = fun s -> Pprz.float_assoc s vs in
let wgs84 = { posn_lat = (Deg>>Rad)(a "target_lat"); posn_long = (Deg>>Rad)(a "target_long") } in
carrot_pos_msg ac.track wgs84;
ac.track#move_carrot wgs84;
let cur_block = Pprz.int_assoc "cur_block" vs
and cur_stage = Pprz.int_assoc "cur_stage" vs in
highlight_fp ac cur_block cur_stage;
@@ -523,7 +510,7 @@ let listen_flight_params = fun geomap auto_center_new_ac ->
set_label "/" "target_climb";
let b = List.assoc cur_block ac.blocks in
if b <> ac.last_block_name then begin
Speech.say (sprintf "%s, %s" ac.ac_name b);
log_and_say alert (sprintf "%s, %s" ac.ac_name b);
ac.last_block_name <- b;
let b = String.sub b 0 (min 10 (String.length b)) in
Strip.set_label ac.strip "block_name" b
@@ -535,10 +522,10 @@ let listen_flight_params = fun geomap auto_center_new_ac ->
let ac_id = Pprz.string_assoc "ac_id" vs in
let ac = Hashtbl.find live_aircrafts ac_id in
let a = fun s -> Pprz.float_assoc s vs in
let wgs84 = { posn_lat = (Deg>>Rad)(a "cam_lat"); posn_long = (Deg>>Rad)(a "cam_long") }
let cam_wgs84 = { posn_lat = (Deg>>Rad)(a "cam_lat"); posn_long = (Deg>>Rad)(a "cam_long") }
and target_wgs84 = { posn_lat = (Deg>>Rad)(a "cam_target_lat"); posn_long = (Deg>>Rad)(a "cam_target_long") } in
cam_pos_msg ac.track wgs84 target_wgs84
ac.track#move_cam cam_wgs84 target_wgs84
in
safe_bind "CAM_STATUS" get_cam_status;
@@ -546,7 +533,7 @@ let listen_flight_params = fun geomap auto_center_new_ac ->
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))
ac.track#draw_circle wgs84 (float_of_string (Pprz.string_assoc "radius" vs))
in
safe_bind "CIRCLE_STATUS" get_circle_status;
@@ -556,7 +543,7 @@ let listen_flight_params = fun geomap auto_center_new_ac ->
let a = fun s -> Pprz.float_assoc s vs in
let geo1 = { posn_lat = (Deg>>Rad)(a "segment1_lat"); posn_long = (Deg>>Rad)(a "segment1_long") }
and geo2 = { posn_lat = (Deg>>Rad)(a "segment2_lat"); posn_long = (Deg>>Rad)(a "segment2_long") } in
segment_status_msg ac.track geo1 geo2
ac.track#draw_segment geo1 geo2
in
safe_bind "SEGMENT_STATUS" get_segment_status;
@@ -566,28 +553,35 @@ let listen_flight_params = fun geomap auto_center_new_ac ->
let a = fun s -> Pprz.float_assoc s vs in
let geo1 = { posn_lat = (Deg>>Rad)(a "south_lat"); posn_long = (Deg>>Rad)(a "west_long") }
and geo2 = { posn_lat = (Deg>>Rad)(a "north_lat"); posn_long = (Deg>>Rad)(a "east_long") } in
survey_status_msg ac.track geo1 geo2
ac.track#draw_zone geo1 geo2
in
safe_bind "SURVEY_STATUS" get_survey_status;
let get_ap_status = fun _sender vs ->
let ac = get_ac vs in
ap_status_msg ac.track ( float_of_int (Pprz.int32_assoc "flight_time" vs ));
ac.track#update_ap_status ( float_of_int (Pprz.int32_assoc "flight_time" vs ));
let ap_mode = Pprz.string_assoc "ap_mode" vs in
if ap_mode <> ac.last_ap_mode then begin
Speech.say (sprintf "%s, %s" ac.ac_name ap_mode);
log_and_say alert (sprintf "%s, %s" ac.ac_name ap_mode);
ac.last_ap_mode <- ap_mode;
Strip.set_label ac.strip "AP" (Pprz.string_assoc "ap_mode" vs);
Strip.set_color ac.strip "AP" (if ap_mode="HOME" then "red" else "white");
Strip.set_color ac.strip "AP" (if ap_mode="HOME" then alert_color else ok_color);
end;
let gps_mode = Pprz.string_assoc "gps_mode" vs in
Strip.set_label ac.strip "GPS" gps_mode;
Strip.set_color ac.strip "GPS" (if gps_mode<>"3D" then "red" else "white");
Strip.set_color ac.strip "GPS" (if gps_mode<>"3D" then alert_color else ok_color);
let ft =
let t = Int32.to_int (Int32.of_string (Pprz.string_assoc "flight_time" vs)) in
sprintf "%02d:%02d:%02d" (t / 3600) ((t mod 3600) / 60) ((t mod 3600) mod 60) in
Strip.set_label ac.strip "flight_time" ft;
let kill_mode = Pprz.string_assoc "kill_mode" vs in
if not ac.in_kill_mode then
if kill_mode <> "OFF" then begin
log_and_say alert (sprintf "%s, mayday, kill mode" ac.ac_name);
ac.in_kill_mode <- true
end else
ac.in_kill_mode <- false;
match ac.rc_settings_page with
None -> ()
| Some p ->
@@ -617,15 +611,9 @@ let listen_waypoint_moved = fun () ->
safe_bind "WAYPOINT_MOVED" get_values
let get_alert_bat_low = fun a _sender vs ->
let ac_id = Pprz.string_assoc "ac_id" vs in
let ac_name = ref "" in
let ac = get_ac vs in
let level = Pprz.string_assoc "level" vs in
let get_config = fun _sender config ->
ac_name := Pprz.string_assoc "ac_name" config;
a#add (!ac_name^" "^"BAT_LOW"^" "^level)
in
Ground_Pprz.message_req "map2d" "CONFIG" ["ac_id", Pprz.String ac_id] get_config
log_and_say a (sprintf "%s %s %s" ac.ac_name "BAT_LOW" level)
let listen_alert = fun a ->
alert_bind "BAT_LOW" (get_alert_bat_low a)
@@ -668,7 +656,7 @@ let get_ts = fun _sender vs ->
let ac = get_ac vs in
let t = Pprz.float_assoc "time_since_last_bat_msg" vs in
Strip.set_label ac.strip "telemetry_status" (if t > 2. then sprintf "%.1f" t else " ");
Strip.set_color ac.strip "telemetry_status" (if t > 5. then "red" else "green")
Strip.set_color ac.strip "telemetry_status" (if t > 5. then alert_color else ok_color)
let listen_telemetry_status = fun () ->
+2 -2
View File
@@ -4,7 +4,7 @@ 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
< center : MapCanvas.LL.geographic -> unit; .. > -> bool -> Pages.alert -> unit
val listen_wind_msg : unit -> unit
val listen_fbw_msg : unit -> unit
val listen_engine_status_msg : unit -> unit
@@ -12,5 +12,5 @@ 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
val listen_alert : Pages.alert -> unit
val listen_telemetry_status : unit -> unit
+6 -4
View File
@@ -39,13 +39,15 @@ class alert (widget: GBin.frame) =
in
let view = GText.view ~editable:false ~packing: scrolled#add () in
(* the object itselft *)
object
val active = Hashtbl.create 5
object (self)
val mutable last = ""
method add text =
if not (Hashtbl.mem active text) then begin
if text <> last then begin
let l = Unix.localtime (Unix.gettimeofday ()) in
view#buffer#insert (sprintf "%2d:%2d:%2d " l.Unix.tm_hour l.Unix.tm_min l.Unix.tm_sec);
view#buffer#insert text;
view#buffer#insert "\n";
Hashtbl.add active text ()
last <- text
end
end
+1
View File
@@ -97,6 +97,7 @@ let add config color select center_ac commit_moves mark =
(** set a label *)
let set_label strip name value =
let _eb, l = List.assoc (name^"_value") strip.labels in
if l#text <> value then
l#set_label value
(** set a label *)
+10 -10
View File
@@ -24,8 +24,8 @@ Q=@
INCLUDES= -I +xml-light
XINCLUDES= -I +lablgl -I +lablgtk2 -I +xml-light
OCAMLC=ocamlc $(INCLUDES)
OCAMLOPT=ocamlopt $(INCLUDES)
OCAMLC=ocamlc
OCAMLOPT=ocamlopt
SRC = debug.ml env.ml serial.ml ocaml_tools.ml extXml.ml xml2h.ml latlong.ml srtm.ml http.ml gm.ml iGN.ml wavecard.ml geometry_2d.ml geometry_3d.ml cserial.o convert.o ubx.ml pprz.ml xbee.ml
@@ -60,38 +60,38 @@ xlib-pprz.cmxa : $(XCMX)
xml_get.out : lib-pprz.cma xml_get.cmo
@echo OL $@
$(Q)$(OCAMLC) -o $@ str.cma xml-light.cma -I . $^
$(Q)$(OCAMLC) $(INCLUDES) -o $@ str.cma xml-light.cma -I . $^
GTKCFLAGS := -I /usr/lib/gtk-2.0/include -I/usr/include/gtk-2.0 -I/usr/include/atk-1.0 -I/usr/include/glib-2.0 -I/usr/lib/glib-2.0/include -I/usr/include/pango-1.0 -I /usr/include/cairo
# GTKCFLAGS := $(shell gtk-config --cflags)
%.o : %.c
@echo OC $<
$(Q)$(OCAMLC) -c $<
$(Q)$(OCAMLC) $(INCLUDES) -c $<
ml_gtk_drag.o : ml_gtk_drag.c
@echo OC $<
$(Q)$(OCAMLC) -c -ccopt "$(GTKCFLAGS)" $<
$(Q)$(OCAMLC) $(INCLUDES) -c -ccopt "$(GTKCFLAGS)" $<
ml_gtkgl_hack.o : ml_gtkgl_hack.c
@echo OC $<
$(Q)$(OCAMLC) -c -ccopt "$(GTKCFLAGS)" $<
$(Q)$(OCAMLC) $(INCLUDES) -c -ccopt "$(GTKCFLAGS)" $<
%.cmo : %.ml
@echo OC $<
$(Q)$(OCAMLC) -c $<
$(Q)$(OCAMLC) $(INCLUDES) -c $<
%.cmx : %.ml
@echo OOC $<
$(Q)$(OCAMLOPT) -c $<
$(Q)$(OCAMLOPT) $(INCLUDES) -c $<
%.cmi : %.mli
@echo OC $<
$(Q)$(OCAMLC) $<
$(Q)$(OCAMLC) $(INCLUDES) $<
%.cmi : %.ml
@echo OC $<
$(Q)$(OCAMLC) $<
$(Q)$(OCAMLC) $(INCLUDES) $<
clean :
rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so
+65 -62
View File
@@ -91,9 +91,8 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
let _desired_circle = GnoCanvas.ellipse group
and _desired_segment = GnoCanvas.line group in
let top = ref 0 in
object (self)
val mutable top = 0
val mutable color = color
val mutable segments = Array.create size empty
val mutable v_segments = Array.create size empty
@@ -102,9 +101,6 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
val mutable last_altitude = 0.0
val mutable last_speed = 0.0
val mutable last_climb = 0.0
val mutable last_height = 0.0
val mutable last_xw = 0.0
val mutable last_yw = 0.0
val mutable last_flight_time = 0.0
val mutable last_x_val = 0.0
val mutable cam_on = false
@@ -112,25 +108,25 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
val mutable v_params_on = false
val mutable desired_track = NoDesired
val zone = GnoCanvas.rect group
val mutable ac_cam_cover = GnoCanvas.rect cam
val mutable ac_cam_cover = GnoCanvas.rect ~fill_color:"grey" ~props:[`WIDTH_PIXELS 1 ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] cam
method color = color
method set_color c = color <- c
method track = track
method aircraft = aircraft
method set_label = fun s -> ac_label#set [`TEXT s]
method clear_one = fun i seg ->
if seg.(i) != empty then begin
(snd seg.(i))#destroy ();
seg.(i) <- empty
method clear_one = fun i ->
if segments.(i) != empty then begin
(snd segments.(i))#destroy ();
segments.(i) <- empty
end
method incr = fun seg ->
let s = Array.length seg in
top := (!top + 1) mod s
method clear = fun seg top ->
for i = 0 to Array.length seg - 1 do
self#clear_one i seg
top <- (top + 1) mod s
method clear = fun () ->
for i = 0 to Array.length segments - 1 do
self#clear_one i
done;
top := 0
top <- 0
method set_cam_state = fun b ->
cam_on <- b;
if b then begin
@@ -143,7 +139,10 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
method update_ap_status = fun time ->
last_flight_time <- time
method set_params_state = fun b -> params_on <- b
method set_params_state = fun b ->
params_on <- b;
if not b then (* Reset to the default simple label *)
ac_label#set [`TEXT name; `Y 25.]
method set_v_params_state = fun b -> v_params_on <- b
method set_last = fun x -> last <- x
method last = last
@@ -151,37 +150,42 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
method last_heading = last_heading
method last_altitude = last_altitude
method height = fun () ->
match last with
None -> last_altitude
| Some wgs84 ->
let h = try float (Srtm.of_wgs84 wgs84) with _ -> 0. in
last_altitude -. h
(** add track points on map2D, according to the
track parameter *)
method add_point = fun geo seg set_last_point last_point top track ->
self#clear_one (!top) seg ;
begin
match last_point with
None ->
seg.((!top)) <- (geo, geomap#segment ~group:track ~fill_color:color geo geo)
| Some last_geo ->
seg.((!top)) <- (geo, geomap#segment ~group:track ~width:2 ~fill_color:color last_geo geo);
end;
self#incr seg;
(set_last_point (Some geo) : unit)
method add_point = fun geo ->
self#clear_one top;
let last_geo =
match last with
None -> geo
| Some last_geo -> last_geo in
segments.(top) <- (geo, geomap#segment ~group ~fill_color:color last_geo geo);
self#incr segments;
self#set_last (Some geo)
method clear_map2D = self#clear segments top
method clear_map2D = self#clear ()
method move_icon = fun wgs84 heading altitude relief_height speed climb ->
method move_icon = fun wgs84 heading altitude speed climb ->
let (xw,yw) = geomap#world_of wgs84 in
aircraft#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw heading);
last_heading <- heading;
last_altitude <- altitude;
last_yw <- yw;
last_height <- (altitude -. relief_height);
last_speed <- speed ;
last_climb <- climb;
if params_on then
ac_label#set [`TEXT ( name^" \n"^(string_of_float last_height)^" m\n"^(string_of_float last_speed)^" m/s\n" ); `Y 70. ] else
ac_label#set [`TEXT name; `Y 25.];
if params_on then begin
let last_height = self#height () in
ac_label#set [`TEXT ( name^" \n"^(string_of_float last_height)^" m\n"^(string_of_float last_speed)^" m/s\n" ); `Y 70. ]
end;
ac_label#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw 0.);
self#add_point wgs84 segments (self#set_last) last top group;
self#add_point wgs84;
method move_carrot = fun wgs84 ->
let (xw,yw) = geomap#world_of wgs84 in
@@ -225,22 +229,19 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
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 ->
if cam_on then
let (xw,yw) = geomap#world_of wgs84 in
let (mission_target_xw, mission_target_yw) = geomap#world_of mission_target_wgs84 in
let last_height_scaled = last_height in
method move_cam = fun cam_wgs84 mission_target_wgs84 ->
match last, cam_on with
Some last_ac, true ->
let (cam_xw, cam_yw) = geomap#world_of cam_wgs84
and (last_xw, last_yw) = geomap#world_of last_ac
and last_height_scaled = self#height () in
(** all data are at map scale *)
begin
let pt1 = { G2d.x2D = last_xw; y2D = last_yw} in
let pt2 = { G2d.x2D = xw ; y2D = yw } in
let pt2 = { G2d.x2D = cam_xw ; y2D = cam_yw } in
(** y axis is downwards so North vector is as follows: *)
let vect_north = (G2d.vect_make { G2d.x2D = 0.0 ; y2D = 0.0 } { G2d.x2D = 0.0 ; y2D = -1.0 } ) in
let vect_north = { G2d.x2D = 0.0 ; y2D = -1.0 } in
let d = G2d.distance pt1 pt2 in
begin
let cam_heading =
if d > min_distance_scaled then
let cam_vect_normalized = (G2d.vect_normalize (G2d.vect_make pt1 pt2)) in
@@ -249,52 +250,54 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva
else norm_angle_360 ( G2d.rad2deg (G2d.m_pi -. asin (G2d.cross_product vect_north cam_vect_normalized)))
else last_heading in
let (angle_of_view, oblic_distance) =
if last_height < min_height_scaled then
if last_height_scaled < min_height_scaled then
(half_pi, max_oblic_distance_scaled)
else
let oav = atan ( d /. last_height_scaled) in
(oav, last_height_scaled /. (cos oav))
in
let alpha_1 = angle_of_view +. cam_half_aperture in
begin
let cam_field_half_height_1 =
if alpha_1 < half_pi then
(tan alpha_1) *. last_height_scaled -. d
else max_cam_half_height_scaled in
let cam_field_half_height_2 = d -. (tan ( angle_of_view -. cam_half_aperture)) *. last_height_scaled in
let cam_field_half_width = ( tan (cam_half_aperture) ) *. oblic_distance in
begin
(*** Printf.printf "dist %.2f aoview %.2f oblic_distance %.2f cfh1 %.2f cfh2 %.2f cfhw %.2f last_xw %.2f last_yw %.2f cam_heading %.2f \n%!" (d *. (geomap#get_world_unit ()) ) angle_of_view (oblic_distance *. (geomap#get_world_unit ()) ) (cam_field_half_height_1 *. (geomap#get_world_unit ()) ) (cam_field_half_height_2 *. (geomap#get_world_unit ()) ) (cam_field_half_width *. (geomap#get_world_unit ()) ) last_xw last_yw cam_heading; ***)
ac_cam_cover#destroy ();
ac_cam_cover <- GnoCanvas.rect ~x1:(-. cam_field_half_width) ~y1:(-. cam_field_half_height_1) ~x2:(cam_field_half_width) ~y2:(cam_field_half_height_2) ~fill_color:"grey" ~props:[`WIDTH_PIXELS 1 ; `OUTLINE_COLOR color; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] cam
end
end;
cam#affine_absolute (affine_pos_and_angle 1.0 xw yw cam_heading);
ac_cam_cover#set [`X1 (-. cam_field_half_width);
`Y1 (-. cam_field_half_height_1);
`X2 (cam_field_half_width);
`Y2(cam_field_half_height_2);
`OUTLINE_COLOR color];
cam#affine_absolute (affine_pos_and_angle 1.0 cam_xw cam_yw cam_heading);
let (mission_target_xw, mission_target_yw) = geomap#world_of mission_target_wgs84 in
mission_target#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value mission_target_xw mission_target_yw 0.0)
end;
end
| _ -> ()
method zoom = fun z ->
let a = aircraft#i2w_affine in
let z' = sqrt (a.(0)*.a.(0)+.a.(1)*.a.(1)) in
for i = 0 to 3 do a.(i) <- a.(i) /. z' *. 1./.z done;
aircraft#affine_absolute a
method resize = fun new_size ->
let a = Array.create new_size empty in
let size = Array.length segments in
let m = min new_size size in
let j = ref ((!top - m + size) mod size) in
let j = ref ((top - m + size) mod size) in
for i = 0 to m - 1 do
a.(i) <- segments.(!j);
j := (!j + 1) mod size
done;
for i = 1 to size - new_size do (* Never done if new_size > size *)
self#clear_one !j segments;
self#clear_one !j;
j := (!j + 1) mod size
done;
top := m mod new_size;
top <- m mod new_size;
segments <- a
method size = Array.length segments
initializer ignore(geomap#zoom_adj#connect#value_changed (fun () -> self#zoom geomap#zoom_adj#value))
initializer
ignore(geomap#zoom_adj#connect#value_changed
(fun () -> self#zoom geomap#zoom_adj#value))
end