1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
type color =
| RED
| BLUE
| YELLOW
type food =
| DONUTS
| YOGHURTS
| PIZZA
class answer = object
val mutable color = RED
val mutable food = DONUTS
method answer_color c () = color <- c
method answer_food f () = food <- f
method get_answer = "42"
end
let radio_color poll packing =
let f = GBin.frame ~label:"Color" ~packing () in
let vb = GPack.vbox ~packing:f#add () in
let rb = GButton.radio_button ~label:"Red" ~packing:(vb#pack) () in
rb#connect#clicked (poll#answer_color RED) ;
let rb2 = GButton.radio_button ~group:rb#group ~label:"Blue" ~packing:(vb#pack) () in
rb2#connect#clicked (poll#answer_color BLUE) ;
let rb3 = GButton.radio_button ~group:rb#group ~label:"Yellow" ~packing:(vb#pack) () in
rb3#connect#clicked (poll#answer_color YELLOW)
let radio_food poll =
let vb = GPack.vbox () in
let rb = GButton.radio_button ~label:"Donuts" ~packing:(vb#pack) () in
rb#connect#clicked (poll#answer_food DONUTS) ;
let rb2 = GButton.radio_button ~group:rb#group ~label:"Pizza" ~packing:(vb#pack) () in
rb2#connect#clicked (poll#answer_food PIZZA) ;
let rb3 = GButton.radio_button ~group:rb#group ~label:"Yoghurt" ~packing:(vb#pack) () in
rb3#connect#clicked (poll#answer_food YOGHURTS) ;
vb
let are_you_sure quit =
let md = GWindow.message_dialog
~message:"Are you sure ?"
~message_type:`QUESTION
~buttons:GWindow.Buttons.yes_no
~modal:true () in
let res = md#run () = `YES in
md#destroy () ;
if res then quit ()
let make_druid poll quit =
let d = GnoDruid.druid () in
d#connect#cancel (fun () -> are_you_sure quit) ;
begin
let fp = GnoDruid.druid_page_edge ~position:`START ~aa:true ~title:"Poll !!" () in
fp#set_text "Here is our great new poll.\nPlease answer all the questions !" ;
d#append_page fp
end ;
begin
let cp = GnoDruid.druid_page_standard ~title:"Color" () in
radio_color poll cp#vbox#pack ;
d#append_page cp
end ;
begin
let mp = GnoDruid.druid_page_standard ~title:"Food" () in
mp#append_item ~question:"Favorite food ?" ~additional_info:""
(radio_food poll)#coerce ;
d#append_page mp
end ;
begin
let ep = GnoDruid.druid_page_edge ~position:`FINISH ~aa:true ~title:"The end" () in
ep#set_text "Thank you for your co-operation." ;
d#append_page ep ;
ep#connect#finish
(fun _ ->
let res = GWindow.message_dialog
~message:(Printf.sprintf "The answer is %s!" poll#get_answer)
~message_type:`INFO ~buttons:GWindow.Buttons.close
~modal:true () in
res#run () ;
res#destroy () ;
quit ())
end ;
d
let window_and_druid () =
let w = GWindow.window ~title:"Druid test" () in
let poll = new answer in
w#add (make_druid poll GMain.quit)#coerce ;
w#event#connect#delete
(fun _ -> are_you_sure GMain.quit ; true) ;
w
let _ =
let w = window_and_druid () in
w#show () ;
GMain.main ()
|
