path editing

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  *)
 

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 ========================================= *)

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

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