]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/testinput.ml
"Final" commit that patches termViewer while still enabling XML Diffing.
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / examples / testinput.ml
1 (* $Id$ *)
2
3 open GMain
4
5 let main () =
6   let window = GWindow.window () in
7   window#misc#set_name "Test input";
8   window#connect#destroy ~callback:Main.quit;
9
10   let vbox = GPack.vbox ~packing:window#add () in
11
12   let drawing_area =
13     GMisc.drawing_area ~width:200 ~height:200 ~packing:vbox#add () in
14
15   drawing_area#event#connect#key_press ~callback:
16     begin fun ev ->
17       let key = GdkEvent.Key.keyval ev in
18       if key >= 32 && key < 256 then
19         Printf.printf "I got a %c\n" (Char.chr key)
20       else
21         print_string "I got another key\n";
22       flush stdout;
23       true
24     end;
25
26   drawing_area#event#add
27     [`EXPOSURE;`LEAVE_NOTIFY;`BUTTON_PRESS;
28      `POINTER_MOTION;`POINTER_MOTION_HINT;`PROXIMITY_OUT];
29   drawing_area#event#set_extensions `ALL;
30   drawing_area#misc#set_can_focus true;
31   drawing_area#misc#grab_focus ();
32
33   GButton.button ~label:"Input Dialog" ~packing:vbox#pack ();
34
35   let button =
36     GButton.button ~label:"Quit" ~packing:vbox#pack () in
37
38   button#connect#clicked ~callback:window#destroy;
39
40   window#show ();
41   Main.main ()
42
43 let _ = main ()