Invalid_argument "ml_lookup_from_c" exceptions catching, black background

This commit is contained in:
Pascal Brisset
2007-06-17 10:47:29 +00:00
parent 15dd7a634b
commit a0d7ebbed3
2 changed files with 36 additions and 30 deletions
+21 -18
View File
@@ -235,19 +235,23 @@ let motion_notify = fun (geomap:G.widget) ev ->
(******* Mouse wheel handling ***********************************************)
let any_event = fun (geomap:G.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
try
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
EditFP.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
EditFP.path_notify geomap xwyw
else
let xc = GdkEvent.Scroll.x scroll_event
and yc = GdkEvent.Scroll.y scroll_event in
let xwyw = geomap#window_to_world xc yc in
EditFP.path_notify geomap xwyw
else
false
| _ ->
false
| _ ->
with
Invalid_argument "ml_lookup_from_c" -> (* Raised GdkEvent.get_type *)
false
@@ -263,7 +267,7 @@ let button_press = fun (geomap:G.widget) ev ->
let xc = GdkEvent.Button.x ev
and yc = GdkEvent.Button.y ev in
let (xw,yw) = geomap#window_to_world xc yc in
let thread = fun f x -> ignore (Thread.create f x) in
let wgs84 = geomap#of_world (xw,yw) in
let display_ign = fun () ->
@@ -273,17 +277,16 @@ let button_press = fun (geomap:G.widget) ev ->
try ignore (MapGoogle.display_tile geomap wgs84) with
Gm.Not_available -> ())
() in
let m = if !ign then [`I ("Load IGN tile", display_ign)] else [] in
let m =
if !get_bdortho <> "" then
(`I ("Load BDORTHO", display_bdortho geomap wgs84))::m
else
m in
GToolbox.popup_menu ~entries:([`I ("Load Google tile", display_gm)]@m)
~button:3 ~time:(Int32.of_int 00);
true;
~button:3 ~time:(Int32.of_int 0);
true
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
@@ -566,7 +569,6 @@ let _main =
in
let callback = fun ev ->
Printf.printf "%d\n%!" (GdkEvent.Button.button ev);
match GdkEvent.Button.button ev with
1 -> swap (); true
| 3 -> restart (); true
@@ -576,7 +578,8 @@ let _main =
end;
(** Wait for A/Cs and subsequent messages *)
Live.listen_acs_and_msgs geomap ac_notebook my_alert !auto_center_new_ac;
if not !edit then
Live.listen_acs_and_msgs geomap ac_notebook my_alert !auto_center_new_ac;
(** Display the window *)
let accel_group = menu_fact#accel_group in
+15 -12
View File
@@ -237,7 +237,7 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef (
(** callback bindings *)
(*** canvas#coerce#misc#modify_bg [`NORMAL, `NAME "black"];***)
canvas#coerce#misc#modify_bg [`NORMAL, `BLACK];
ignore (background#connect#event self#background_event);
ignore (canvas#event#connect#motion_notify self#mouse_motion);
@@ -248,7 +248,7 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef (
canvas#set_center_scroll_region false ;
canvas#set_scroll_region (-25000000.) (-25000000.) 25000000. 25000000.;
ignore (GnoCanvas.rect ~props:[`X1 (-25000000.); `Y1 (-25000000.); `X2 25000000.; `Y2 25000000.; `FILL_COLOR "black"] background);
(* ignore (GnoCanvas.rect ~props:[`X1 (-25000000.); `Y1 (-25000000.); `X2 25000000.; `Y2 25000000.; `FILL_COLOR "black"] background); *)
)
@@ -500,16 +500,20 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef (
last_view := view;
Hashtbl.iter (fun cb _ -> cb ()) view_cbs
end;
match GdkEvent.get_type ev with
| `SCROLL when not (Gdk.Convert.test_modifier `SHIFT (GdkEvent.Scroll.state (GdkEvent.Scroll.cast ev))) -> begin
let scroll_event = GdkEvent.Scroll.cast ev in
match GdkEvent.Scroll.direction scroll_event with
`UP -> self#zoom_up (); true
| `DOWN -> self#zoom_down (); true
try
match GdkEvent.get_type ev with
| `SCROLL when not (Gdk.Convert.test_modifier `SHIFT (GdkEvent.Scroll.state (GdkEvent.Scroll.cast ev))) -> begin
let scroll_event = GdkEvent.Scroll.cast ev in
match GdkEvent.Scroll.direction scroll_event with
`UP -> self#zoom_up (); true
| `DOWN -> self#zoom_down (); true
| _ -> false
end
| _ -> false
end
| _ -> false
with
Invalid_argument "ml_lookup_from_c" -> (* Raised GdkEvent.get_type *)
false
method segment = fun ?(group = canvas#root) ?(width=1) ?fill_color geo1 geo2 ->
@@ -540,7 +544,6 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef (
let geo_east = LL.of_utm LL.WGS84 (LL.utm_add utm (radius, 0.)) in
let (xe, _) = self#world_of geo_east in
let rad = xe -. x in
let l = GnoCanvas.ellipse ?fill_color ~props:[`WIDTH_PIXELS width; `OUTLINE_COLOR color] ~x1:(x-.rad) ~y1:(y -.rad) ~x2:(x +.rad) ~y2:(y+.rad) group in
l#show ();
l