diff --git a/sw/ground_segment/cockpit/compass.ml b/sw/ground_segment/cockpit/compass.ml index a8baba33fa..43aeac96bd 100644 --- a/sw/ground_segment/cockpit/compass.ml +++ b/sw/ground_segment/cockpit/compass.ml @@ -1,3 +1,29 @@ +(* +* $Id$ +* +* Compass display for a manned vehicle +* +* Copyright (C) 2004-2009 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. +* +*) + open Printf open Latlong @@ -23,12 +49,13 @@ let circle = fun (dr:GDraw.pixmap) (x,y) r -> let points = Array.init n (fun i -> let a = float i /. float n *. 2.*.pi in - (x + truncate (r*.cos a), x + truncate (r*.sin a))) in + (x + truncate (r*.cos a), y + truncate (r*.sin a))) in dr#polygon (Array.to_list points) -let draw = fun da desired_course course_opt distance -> +let draw = fun (da_object:Gtk_tools.pixmap_in_drawin_area) desired_course course_opt distance -> + let da = da_object#drawing_area in let {Gtk.width=width; height=height} = da#misc#allocation in - let dr = GDraw.pixmap ~width ~height ~window:da () in + let dr = da_object#get_pixmap () in dr#set_foreground background; dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); let s = (min width height) / 8 in @@ -103,8 +130,8 @@ let _ = let quit = fun () -> GMain.Main.quit (); exit 0 in ignore (window#connect#destroy ~callback:quit); - let da = GMisc.drawing_area ~width ~height ~packing:window#add () in - da#misc#realize (); + let da = new Gtk_tools.pixmap_in_drawin_area ~width ~height ~packing:window#add () in + da#drawing_area#misc#realize (); (* Listening messages *) let course = ref None in (* deg *) diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 100456b7b4..de7560db1a 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -583,7 +583,7 @@ let () = let my_alert = new Pages.alert alert_page in (** Altitude graph frame *) - let alt_graph = GMisc.drawing_area () in + let alt_graph = new Gtk_tools.pixmap_in_drawin_area () in (** plugin frame *) let plugin_width = 400 and plugin_height = 300 in @@ -594,7 +594,7 @@ let () = "aircraft", ac_notebook#coerce; "editor", editor_frame#coerce; "alarms", alert_page#coerce; - "altgraph", alt_graph#coerce (*alt_frame#coerce*); + "altgraph", alt_graph#drawing_area#coerce (*alt_frame#coerce*); "plugin", plugin_frame#coerce] in let the_layout = ExtXml.child layout "0" in diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index 2d8c3d1724..b6118f14c6 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/sw/ground_segment/cockpit/live.ml @@ -835,15 +835,16 @@ let rotate_and_translate = fun l angle dx dy -> ) l) dx dy let flip = fun l -> List.map (fun (x, y) -> (-x, y)) l -let draw_altgraph = fun (da:GMisc.drawing_area) (geomap:MapCanvas.widget) aircrafts -> +let draw_altgraph = fun (da_object:Gtk_tools.pixmap_in_drawin_area) (geomap:MapCanvas.widget) aircrafts -> (** First estimate the coverage of the window *) let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window in let (xc0, yc0) = geomap#canvas#get_scroll_offsets in let (east, _y0) = geomap#window_to_world (float xc0) (float (yc0+height_c)) and (west, _y1) = geomap#window_to_world (float (xc0+width_c)) (float yc0) in + let da = da_object#drawing_area in let width, height = Gdk.Drawable.get_size da#misc#window in - let dr = GDraw.pixmap ~width ~height ~window:da () in + let dr = da_object#get_pixmap () in dr#set_background `BLACK; dr#set_foreground `BLACK; diff --git a/sw/ground_segment/cockpit/live.mli b/sw/ground_segment/cockpit/live.mli index 1423afa78f..1782911140 100644 --- a/sw/ground_segment/cockpit/live.mli +++ b/sw/ground_segment/cockpit/live.mli @@ -70,7 +70,7 @@ val safe_bind : string -> (string -> Pprz.values -> unit) -> unit val track_size : int ref (** Default length for A/C tracks on the 2D view *) -val listen_acs_and_msgs : MapCanvas.widget -> GPack.notebook -> Pages.alert -> bool -> GMisc.drawing_area -> unit +val listen_acs_and_msgs : MapCanvas.widget -> GPack.notebook -> Pages.alert -> bool -> Gtk_tools.pixmap_in_drawin_area -> unit (** [listen_acs_and_msgs geomap aircraft_notebook alert_page auto_center_new_ac] *) val jump_to_block : string -> int -> unit diff --git a/sw/ground_segment/cockpit/pages.ml b/sw/ground_segment/cockpit/pages.ml index 9ed23610cd..d2525ecf6e 100644 --- a/sw/ground_segment/cockpit/pages.ml +++ b/sw/ground_segment/cockpit/pages.ml @@ -1,26 +1,26 @@ (* -* $Id$ -* -* Copyright (C) 2006 ENAC, Pierre-Sélim Huard, 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. -* -*) + * $Id$ + * + * Copyright (C) 2006 ENAC, Pierre-Sélim Huard, 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. + * + *) (*****************************************************************************) (* Information pages such as alert, infrared, gps, artificial horizon *) @@ -34,10 +34,10 @@ open Printf (** alert page *) class alert (widget: GBin.frame) = let scrolled = GBin.scrolled_window - ~hpolicy: `AUTOMATIC - ~vpolicy: `AUTOMATIC - ~packing: widget#add - () + ~hpolicy: `AUTOMATIC + ~vpolicy: `AUTOMATIC + ~packing: widget#add + () in let view = GText.view ~editable:false ~packing: scrolled#add () in (* the object itselft *) @@ -57,23 +57,23 @@ class alert (widget: GBin.frame) = last <- text end - end + end (*****************************************************************************) (* infrared page *) (*****************************************************************************) class infrared (widget: GBin.frame) = let table = GPack.table - ~rows: 4 - ~columns: 2 - ~row_spacings: 5 - ~col_spacings: 5 - ~packing: widget#add - () + ~rows: 4 + ~columns: 2 + ~row_spacings: 5 + ~col_spacings: 5 + ~packing: widget#add + () in let contrast_status = GMisc.label ~text: "" ~packing: (table#attach ~top:0 ~left: 1) () - in + in let contrast_value = GMisc.label ~text: "" ~packing: (table#attach ~top:1 ~left: 1) () in @@ -89,24 +89,24 @@ class infrared (widget: GBin.frame) = ignore (GMisc.label ~text: "gps hybrid mode" ~packing: (table#attach ~top:2 ~left: 0) ()); ignore (GMisc.label ~text: "gps hybrid factor" ~packing: (table#attach ~top:3 ~left: 0) ()) in -object - val parent = widget - val table = table + object + val parent = widget + val table = table - val contrast_status = contrast_status - val contrast_value = contrast_value - val gps_hybrid_mode = gps_hybrid_mode - val gps_hybrid_factor = gps_hybrid_factor + val contrast_status = contrast_status + val contrast_value = contrast_value + val gps_hybrid_mode = gps_hybrid_mode + val gps_hybrid_factor = gps_hybrid_factor - method set_contrast_status (s:string) = - contrast_status#set_label s - method set_contrast_value (s:int) = - contrast_value#set_label (Printf.sprintf "%d" s) - method set_gps_hybrid_mode (s:string) = - gps_hybrid_mode#set_label s - method set_gps_hybrid_factor (s:float) = - gps_hybrid_factor#set_label (Printf.sprintf "%.8f" s) -end + method set_contrast_status (s:string) = + contrast_status#set_label s + method set_contrast_value (s:int) = + contrast_value#set_label (Printf.sprintf "%d" s) + method set_gps_hybrid_mode (s:string) = + gps_hybrid_mode#set_label s + method set_gps_hybrid_factor (s:float) = + gps_hybrid_factor#set_label (Printf.sprintf "%.8f" s) + end (*****************************************************************************) (* gps page *) @@ -115,7 +115,8 @@ class gps ?(visible = fun _ -> true) (widget: GBin.frame) = let vbox = GPack.vbox ~packing:widget#add () in let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:vbox#add () in - let da = GMisc.drawing_area ~show:true ~packing:sw#add_with_viewport () in + + let da_object = new Gtk_tools.pixmap_in_drawin_area ~packing:sw#add_with_viewport () in (* Reset buttons *) let hbox = GPack.hbox ~packing:vbox#pack ~show:false () in @@ -124,70 +125,71 @@ class gps ?(visible = fun _ -> true) (widget: GBin.frame) = let warm = GButton.button ~label:"Warmstart" ~packing:hbox#add () in let cold = GButton.button ~label:"Coldstart" ~packing:hbox#add () in -object - val mutable active_cno = [] - val mutable active_flags = [] + object + val mutable active_cno = [] + val mutable active_flags = [] - method connect_reset = fun (callback:int -> unit) -> - hbox#misc#show (); - ignore (hot#connect#clicked (fun () -> callback 0)); - ignore (warm#connect#clicked (fun () -> callback 1)); - ignore (cold#connect#clicked (fun () -> callback 2)) + method connect_reset = fun (callback:int -> unit) -> + hbox#misc#show (); + ignore (hot#connect#clicked (fun () -> callback 0)); + ignore (warm#connect#clicked (fun () -> callback 1)); + ignore (cold#connect#clicked (fun () -> callback 2)) - method svsinfo pacc a = - if visible widget then - let {Gtk.width=width; height=height} = da#misc#allocation in - - (* Background *) - let dr = GDraw.pixmap ~width ~height ~window:da () in - dr#set_foreground (`NAME "white"); - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - - let context = da#misc#create_pango_context in - context#set_font_by_name ("sans " ^ string_of_int 10); - let layout = context#create_layout in - - let n = Array.length a in - let sep_size = 3 in - let indic_size = min 25 ((width-(n+1)*sep_size)/n) in - let max_cn0 = 50 in + method svsinfo pacc a = + if visible widget then + let da = da_object#drawing_area in + let {Gtk.width=width; height=height} = da#misc#allocation in + + (* Background *) + let dr = da_object#get_pixmap () in + dr#set_foreground (`NAME "white"); + dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); + + let context = da#misc#create_pango_context in + context#set_font_by_name ("sans " ^ string_of_int 10); + let layout = context#create_layout in + + let n = Array.length a in + let sep_size = 3 in + let indic_size = min 25 ((width-(n+1)*sep_size)/n) in + let max_cn0 = 50 in - Pango.Layout.set_text layout "Dummy"; - let (_, h) = Pango.Layout.get_pixel_size layout in + Pango.Layout.set_text layout "Dummy"; + let (_, h) = Pango.Layout.get_pixel_size layout in - let size = fun cn0 -> (max 20 cn0 - 20) * 2 in + let size = fun cn0 -> (max 20 cn0 - 20) * 2 in - let y = sep_size + h + (size max_cn0) in - for i = 0 to n - 1 do - let (id, cn0, flags, age) = a.(i) in - if age < 60 then - let x = sep_size + i * (sep_size+indic_size) in - - (* level *) - Pango.Layout.set_text layout (sprintf "% 2d" cn0); - dr#put_layout ~x ~y:0 ~fore:`BLACK layout; - - (* bar *) - let color = if age > 5 then "grey" else if flags land 0x01 = 1 then "green" else "red" in - dr#set_foreground (`NAME color); - let height = size cn0 in - dr#rectangle ~filled:true ~x ~y:(y-height) ~width:indic_size ~height (); - (* SV id *) - Pango.Layout.set_text layout (sprintf "% 2d" id); - dr#put_layout ~x ~y ~fore:`BLACK layout - done; + let y = sep_size + h + (size max_cn0) in + for i = 0 to n - 1 do + let (id, cn0, flags, age) = a.(i) in + if age < 60 then + let x = sep_size + i * (sep_size+indic_size) in + + (* level *) + Pango.Layout.set_text layout (sprintf "% 2d" cn0); + dr#put_layout ~x ~y:0 ~fore:`BLACK layout; + + (* bar *) + let color = if age > 5 then "grey" else if flags land 0x01 = 1 then "green" else "red" in + dr#set_foreground (`NAME color); + let height = size cn0 in + dr#rectangle ~filled:true ~x ~y:(y-height) ~width:indic_size ~height (); + (* SV id *) + Pango.Layout.set_text layout (sprintf "% 2d" id); + dr#put_layout ~x ~y ~fore:`BLACK layout + done; - (* Pacc *) - let max_pacc = 2000 in - dr#set_foreground (`NAME "red"); - let w = min width ((pacc*width)/max_pacc) in - dr#rectangle ~filled:true ~x:0 ~y:(y+h) ~width:w ~height:h (); - Pango.Layout.set_text layout (if pacc = 0 then "Pos accuracy: N/A" else sprintf "Pos accuracy: %.1fm" (float pacc/.100.)); - let (_, h) = Pango.Layout.get_pixel_size layout in - dr#put_layout ~x:((width-w)/2) ~y:(y+h) ~fore:`BLACK layout; - - (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap -end + (* Pacc *) + let max_pacc = 2000 in + dr#set_foreground (`NAME "red"); + let w = min width ((pacc*width)/max_pacc) in + dr#rectangle ~filled:true ~x:0 ~y:(y+h) ~width:w ~height:h (); + Pango.Layout.set_text layout (if pacc = 0 then "Pos accuracy: N/A" else sprintf "Pos accuracy: %.1fm" (float pacc/.100.)); + let (_, h) = Pango.Layout.get_pixel_size layout in + dr#put_layout ~x:((width-w)/2) ~y:(y+h) ~fore:`BLACK layout; + + (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap + end (*****************************************************************************) (* Misc page *) @@ -201,7 +203,7 @@ let index_of = fun label -> failwith (sprintf "Unknown label in Misc.index_of: %s" label) in search 0 - + class misc ~packing (widget: GBin.frame) = let rows = Array.length misc_fields in let table = GPack.table ~rows ~columns:2 ~row_spacings:5 ~col_spacings:40 ~packing () in @@ -232,11 +234,11 @@ let rc_setting_index = function let rc_mode_index = function "AUTO1" -> 0 | "AUTO2" -> 1 - | x -> -1 + | _x -> -1 let rc_setting_mode_index = function "UP" -> 0 | "DOWN" -> 1 - | x -> -1 + | _x -> -1 let one_rc_mode = fun (table:GPack.table) rc_mode -> let i = rc_mode_index (ExtXml.attrib rc_mode "name") in @@ -245,9 +247,9 @@ let one_rc_mode = fun (table:GPack.table) rc_mode -> and text = ExtXml.attrib rc_setting "var" in let (j, k) = rc_setting_index name in ignore (GMisc.label ~text ~packing:(table#attach ~top:(1+2*j+k) ~left:(1+2*i)) ()) - ) + ) (Xml.children rc_mode) - + class rc_settings = fun ?(visible = fun _ -> true) xmls -> let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in @@ -283,13 +285,13 @@ class rc_settings = fun ?(visible = fun _ -> true) xmls -> method widget = sw#coerce method set = fun v1 v2 -> if visible self#widget then - let i = rc_mode_index rc_mode - and j = rc_setting_mode_index rc_setting_mode in - if i >= 0 && j >= 0 then - let s1 = string_of_float v1 in - let s2 = string_of_float v2 in - - values.(i).(j).(0)#set_text s1; - values.(i).(j).(1)#set_text s2 + let i = rc_mode_index rc_mode + and j = rc_setting_mode_index rc_setting_mode in + if i >= 0 && j >= 0 then + let s1 = string_of_float v1 in + let s2 = string_of_float v2 in + + values.(i).(j).(0)#set_text s1; + values.(i).(j).(1)#set_text s2 end diff --git a/sw/ground_segment/cockpit/strip.ml b/sw/ground_segment/cockpit/strip.ml index 03ee7f8fbe..f10a07ff06 100644 --- a/sw/ground_segment/cockpit/strip.ml +++ b/sw/ground_segment/cockpit/strip.ml @@ -78,6 +78,7 @@ let set_color labels name color = class gauge = fun (gauge_da:GMisc.drawing_area) -> object (self) + inherit Gtk_tools.pixmap_in_drawin_area ~drawing_area:gauge_da () method layout = fun string -> let context = gauge_da#misc#create_pango_context in let layout = context#create_layout in @@ -101,7 +102,7 @@ class vgauge = fun ?(color="green") ?(history_len=50) gauge_da v_min v_max -> method set = fun ?arrow ?(background="orange") value strings -> let {Gtk.width=width; height=height} = gauge_da#misc#allocation in if height > 1 then (* Else the drawing area is not allocated already *) - let dr = GDraw.pixmap ~width ~height ~window:gauge_da () in + let dr = self#get_pixmap () in dr#set_foreground (`NAME background); dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); @@ -169,7 +170,7 @@ class hgauge = fun ?(color="green") gauge_da v_min v_max -> method set = fun ?(background="orange") value string -> let {Gtk.width=width; height=height} = gauge_da#misc#allocation in if height > 1 then (* Else the drawing area is not allocated already *) - let dr = GDraw.pixmap ~width ~height ~window:gauge_da () in + let dr = self#get_pixmap () in dr#set_foreground (`NAME background); dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); diff --git a/sw/lib/ocaml/gtk_tools.ml b/sw/lib/ocaml/gtk_tools.ml index cac4a7a4ff..d44d88a0d9 100644 --- a/sw/lib/ocaml/gtk_tools.ml +++ b/sw/lib/ocaml/gtk_tools.ml @@ -27,8 +27,12 @@ (** GTK utilities *) -class pixmap_in_drawin_area = fun ~width ~height ~packing () -> - let da = GMisc.drawing_area ~width ~height ~show:true ~packing () in +class pixmap_in_drawin_area = fun ?drawing_area ?width ?height ?packing () -> + let da = + match drawing_area with + None -> + GMisc.drawing_area ?width ?height ~show:true ?packing () + | Some d -> d in object val mutable pixmap = None diff --git a/sw/lib/ocaml/gtk_tools.mli b/sw/lib/ocaml/gtk_tools.mli index 3e3d363806..c5489d68a6 100644 --- a/sw/lib/ocaml/gtk_tools.mli +++ b/sw/lib/ocaml/gtk_tools.mli @@ -26,11 +26,13 @@ (** GTK utilities *) -(** Allocate a drawing area and filling pixmap on request *) +(** Allocate a drawing area and filling pixmap on request. + if ~drawing_area is provided, width, heigh and packing are ignored *) class pixmap_in_drawin_area : - width:int -> - height:int -> - packing:(GObj.widget -> unit) -> + ?drawing_area:GMisc.drawing_area -> + ?width:int -> + ?height:int -> + ?packing:(GObj.widget -> unit) -> unit -> object method drawing_area : GMisc.drawing_area diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index 3d65ed1f59..697bc6b52a 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -43,7 +43,7 @@ plotter : plotter.cmo plot : log_file.cmx gtk_export.cmx export.cmx plot.cmx @echo OL $@ - $(Q)$(OCAMLOPT) $(INCLUDES) -o $@ unix.cmxa str.cmxa xml-light.cmxa glibivy-ocaml.cmxa lablgtk.cmxa lib-pprz.cmxa lablglade.cmxa gtkInit.cmx $^ + $(Q)$(OCAMLOPT) $(INCLUDES) -o $@ unix.cmxa str.cmxa xml-light.cmxa glibivy-ocaml.cmxa lablgtk.cmxa lib-pprz.cmxa xlib-pprz.cmxa lablglade.cmxa gtkInit.cmx $^ sd2log : sd2log.cmo @echo OL $@ diff --git a/sw/logalizer/plot.ml b/sw/logalizer/plot.ml index 5d0069dd75..c365f1ca47 100644 --- a/sw/logalizer/plot.ml +++ b/sw/logalizer/plot.ml @@ -80,7 +80,6 @@ let labelled_entry = fun ?width_chars text value (h:GPack.box) -> label, GEdit.entry ?width_chars ~text:value ~packing:h#pack () class plot = fun ~width ~height ~packing () -> - let da = GMisc.drawing_area ~width ~height ~show:true ~packing () in let curves = Hashtbl.create 3 in object (self) val mutable min_x = max_float @@ -92,6 +91,7 @@ class plot = fun ~width ~height ~packing () -> val mutable csts = ([] : float list) val mutable auto_scale = true + inherit Gtk_tools.pixmap_in_drawin_area ~width ~height ~packing () method private update_scale = fun values -> let n = Array.length values in @@ -136,8 +136,6 @@ class plot = fun ~width ~height ~packing () -> method destroy = fun () -> () - method drawing_area = da - method add_cst = fun v -> csts <- v :: csts; self#redraw () @@ -164,8 +162,9 @@ class plot = fun ~width ~height ~packing () -> self#redraw () method redraw = fun () -> + let da = self#drawing_area in let {Gtk.width=width; height=height} = da#misc#allocation in - let dr = GDraw.pixmap ~width ~height ~window:da () in + let dr = self#get_pixmap () in dr#set_foreground (`NAME "white"); dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); @@ -252,7 +251,7 @@ class plot = fun ~width ~height ~packing () -> (* Actually draw *) (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap - initializer(ignore (da#event#connect#expose ~callback:(fun _ -> self#redraw (); false))) + initializer(ignore (self#drawing_area#event#connect#expose ~callback:(fun _ -> self#redraw (); false))) end