diff --git a/sw/ground_segment/cockpit/map2d.ml b/sw/ground_segment/cockpit/map2d.ml index 5e29f34a22..5aba5750b6 100644 --- a/sw/ground_segment/cockpit/map2d.ml +++ b/sw/ground_segment/cockpit/map2d.ml @@ -24,6 +24,7 @@ * *) +module G2D = Geometry_2d open Printf open Latlong @@ -552,9 +553,11 @@ module Edit = struct let create_wp = fun geomap geo -> match !current_fp with - None -> GToolbox.message_box "Error" "Load a flight plan first" + None -> + GToolbox.message_box "Error" "Load a flight plan first"; + failwith "create_wp" | Some (fp,_) -> - ignore (fp#add_waypoint geo) + fp#add_waypoint geo let save_fp = fun geomap () -> @@ -622,13 +625,100 @@ module Edit = struct Printf.fprintf f "%s\n" (Xml.to_string_fmt xml); close_out f)); dialog#show () + + let radius = ref 30. + let path = ref [] + let cur_arc = ref None + and cur_seg = ref None + and cur_f = ref { G2D.x2D = 0.; y2D = 0. } + let path_button = fun (geomap:MapCanvas.widget) (xw, yw) -> + let geo = geomap#of_world (xw, yw) in + let wp = create_wp geomap geo in + if !path = [] then + cur_f := {G2D.x2D=xw; G2D.y2D=yw}; + path := (wp, !cur_arc, !cur_seg, !cur_f) :: !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 + | (wp1, _, _, ll) :: p -> + let (xl, yl) = geomap#world_of wp1#pos in + begin + match !cur_seg with + None -> failwith "path_notify" + | Some segment -> + match p with + [] -> + segment#set [`POINTS [|xl;yl;xw;yw|]] + | _::_ -> + match !cur_arc with + None -> failwith "path_notify" + | Some arc -> + arc#destroy (); + let l = {G2D.x2D = xl; y2D = yl } + and p = {G2D.x2D = xw; y2D = yw } in + let (c, f, s) = G2D.arc_segment ll l p !radius in + let xf = f.G2D.x2D and yf = f.G2D.y2D in + segment#set [`POINTS [|xf;yf;xw;yw|]]; + let cl = G2D.vect_make c l + and cf = G2D.vect_make c f in + let al = (G2D.cart2polar 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 + let arc = geomap#arc ~nb_points:10 ~fill_color:"blue" ~width:2 (xc,yc) !radius a1 a2 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; + path := [] + + let path_change_radius = function + `UP -> radius := !radius *. 1.25 + | `DOWN -> radius := !radius /. 1.25 + | _ -> () end (** Edit module *) +let motion_notify = fun (geomap:MapCanvas.widget) ev -> + let xc = GdkEvent.Motion.x ev + and yc = GdkEvent.Motion.y ev in + let xwyw = geomap#window_to_world xc yc in + Edit.path_notify geomap xwyw + +let any_event = fun (geomap:MapCanvas.widget) ev -> + match GdkEvent.get_type ev with + `SCROLL -> + let state = GdkEvent.Scroll.state (GdkEvent.Scroll.cast ev) in + if Gdk.Convert.test_modifier `CONTROL state && Gdk.Convert.test_modifier `SHIFT state then + let scroll_event = GdkEvent.Scroll.cast ev in + Edit.path_change_radius (GdkEvent.Scroll.direction scroll_event); + let xc = GdkEvent.Scroll.x scroll_event + and yc = GdkEvent.Scroll.y scroll_event in + let xwyw = geomap#window_to_world xc yc in + Edit.path_notify geomap xwyw + else + false + | _ -> + false + let button_press = fun (geomap:MapCanvas.widget) ev -> let state = GdkEvent.Button.state ev in - if GdkEvent.Button.button ev = 3 then begin + if GdkEvent.Button.button ev = 3 && Gdk.Convert.test_modifier `CONTROL state && Gdk.Convert.test_modifier `SHIFT state then begin + Edit.path_close (); + true + end else if GdkEvent.Button.button ev = 3 then begin (** Display a tile from Google Maps or IGN *) let xc = GdkEvent.Button.x ev and yc = GdkEvent.Button.y ev in @@ -644,15 +734,22 @@ let button_press = fun (geomap:MapCanvas.widget) ev -> ignore(Thread.create display wgs84); true; - end else if GdkEvent.Button.button ev = 1 && Gdk.Convert.test_modifier `CONTROL state then begin - let xc = GdkEvent.Button.x ev in - let yc = GdkEvent.Button.y ev in - let xyw = geomap#canvas#window_to_world xc yc in - let geo = geomap#of_world xyw in - Edit.create_wp geomap geo; - true - end else - false + end else if GdkEvent.Button.button ev = 1 && Gdk.Convert.test_modifier `CONTROL state then + if Gdk.Convert.test_modifier `SHIFT state then begin + let xc = GdkEvent.Button.x ev in + let yc = GdkEvent.Button.y ev in + let xyw = geomap#canvas#window_to_world xc yc in + Edit.path_button geomap xyw; + true + end else begin + let xc = GdkEvent.Button.x ev in + let yc = GdkEvent.Button.y ev in + let xyw = geomap#canvas#window_to_world xc yc in + let geo = geomap#of_world xyw in + ignore (Edit.create_wp geomap geo); + true + end else + false @@ -698,6 +795,8 @@ let _ = let accel_group = geomap#menu_fact#accel_group in ignore (geomap#canvas#event#connect#button_press (button_press geomap)); + ignore (geomap#canvas#event#connect#motion_notify (motion_notify geomap)); + ignore (geomap#canvas#event#connect#any (any_event geomap)); (** widget displaying aircraft vertical position *) diff --git a/sw/lib/ocaml/geometry_2d.ml b/sw/lib/ocaml/geometry_2d.ml index d481c730a4..fc813a4224 100644 --- a/sw/lib/ocaml/geometry_2d.ml +++ b/sw/lib/ocaml/geometry_2d.ml @@ -856,14 +856,25 @@ let arc_segment = fun p0 p1 p2 radius -> (* F first point of the segment *) let d_c2 = distance c p2 in - assert (radius < d_c2); - let alpha_2cf = -. s *. acos (radius /. d_c2) - and alpha_c2 = (cart2polar (vect_make c p2)).theta2D in - let alpha_cf = alpha_c2 +. alpha_2cf in - let f = vect_add c (polar2cart {theta2D=alpha_cf;r2D=radius}) in + if radius > d_c2 then + (** Arc is empty *) + (c, p1, s) + else + let alpha_2cf = -. s *. acos (radius /. d_c2) + and alpha_c2 = (cart2polar (vect_make c p2)).theta2D in + let alpha_cf = alpha_c2 +. alpha_2cf in + let f = vect_add c (polar2cart {theta2D=alpha_cf;r2D=radius}) in + + (c, f, s) - (c, f, s) - +let arc = fun ?(nb_points=5) c r a1 a2 -> + let a2 = if a2 < a1 then a2 +. 2. *. m_pi else a2 in + let da = (a2 -. a1) /. float (nb_points-1) in + Array.init nb_points + (fun i -> + let a = a1 +. float i *. da in + vect_add c (polar2cart { r2D = r; theta2D = a })) + (* =============================== FIN ========================================= *) diff --git a/sw/lib/ocaml/geometry_2d.mli b/sw/lib/ocaml/geometry_2d.mli index feaff25ad1..3dae97ef7b 100644 --- a/sw/lib/ocaml/geometry_2d.mli +++ b/sw/lib/ocaml/geometry_2d.mli @@ -309,3 +309,5 @@ val arc_segment : pt_2D -> pt_2D -> pt_2D -> float -> pt_2D*pt_2D*float arc of radius [r], tangent to segment [po]-[p1] in [p1]. Point [f] is such that [f]-[p2] is tangent to the arc. [s] is 1. if [c] is on the left, [-1] else *) + +val arc : ?nb_points:int -> pt_2D -> float -> float -> float -> pt_2D array diff --git a/sw/lib/ocaml/mapCanvas.ml b/sw/lib/ocaml/mapCanvas.ml index 6f0c749b45..dc97c82249 100644 --- a/sw/lib/ocaml/mapCanvas.ml +++ b/sw/lib/ocaml/mapCanvas.ml @@ -25,6 +25,7 @@ *) module LL = Latlong +module G2D = Geometry_2d open Printf let zoom_factor = 1.5 (* Mouse wheel zoom action *) @@ -44,7 +45,7 @@ type projection = let mercator_coeff = 5e6 - + (** basic canvas with menubar ************************************** * (the vertical display in map2.ml is an instance of basic_widget)* *******************************************************************) @@ -239,7 +240,7 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( let xc = GdkEvent.Button.x ev in let yc = GdkEvent.Button.y ev in match GdkEvent.Button.button ev with - 1 when Gdk.Convert.test_modifier `SHIFT (GdkEvent.Button.state ev) -> + 1 when Gdk.Convert.test_modifier `SHIFT (GdkEvent.Button.state ev) && not (Gdk.Convert.test_modifier `CONTROL (GdkEvent.Button.state ev)) -> let (x1,y1) = self#window_to_world xc yc in grouping <- Some (x1,y1); region_rectangle#set [`X1 x1; `Y1 y1; `X2 x1; `Y2 y1]; @@ -318,7 +319,7 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( end; match GdkEvent.get_type ev with - | `SCROLL -> begin + | `SCROLL when not (Gdk.Convert.test_modifier `SHIFT (GdkEvent.Scroll.state (GdkEvent.Scroll.cast ev))) -> begin let scroll_event = GdkEvent.Scroll.cast ev in let (x, y) = canvas#get_scroll_offsets in let xr = GdkEvent.Scroll.x_root scroll_event in @@ -351,6 +352,19 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( let l = GnoCanvas.line ?fill_color ~props:[`WIDTH_PIXELS width] ~points:[|x1;y1;x2;y2|] group in l#show (); l + + method arc = fun ?(nb_points=5) ?(width=1) ?fill_color (xw,yw) r a1 a2 -> + let c = {G2D.x2D = xw; y2D = yw } in + let pts = G2D.arc ~nb_points c r a1 a2 in + let points = Array.init (2*nb_points) + (fun j -> + let i = j / 2 in + if j = i * 2 then pts.(i).G2D.x2D else pts.(i).G2D.y2D) in + let p = points in + let l = GnoCanvas.line ?fill_color ~props:[`WIDTH_PIXELS width] ~points canvas#root in + l#show (); + l + method circle = fun ?(group = canvas#root) ?(width=1) ?fill_color ?(color="black") geo radius -> let (x, y) = self#world_of geo in