1! GUI handler module
2module gui_handler
3 use gtk_hl
4 use gtk, only: gtk_init, gtk_main, gtk_main_quit, gtk_container_add, &
5 & gtk_widget_show_all
6 implicit none
7
8 type(c_ptr) :: window
9 type(c_ptr) :: hbox, vbox
10 type(c_ptr) :: btn_msg, btn_quit
11
12contains
13 ! show message dialog
14 subroutine cb_msg(widget, gdata) bind(c)
15 type(c_ptr), value :: widget, gdata
16
17 integer(kind=c_int) :: response
18
19 character(len=64) :: msg(4)
20
21 msg(1) = "メッセージ"
22 msg(2) = ""
23 msg(3) = "好きなメッセージを"
24 msg(4) = "ここに表示できます。"
25
26 response = hl_gtk_message_dialog_show(msg, GTK_BUTTONS_OK, &
27 & "メッセージダイアログ"//c_null_char, parent=window)
28 call hl_gtk_box_pack(hbox, btn_msg, expand=FALSE)
29
30 endsubroutine cb_msg
31
32 ! show dialog before quit
33 subroutine cb_quit(widget, gdata) bind(c)
34 type(c_ptr), value :: widget, gdata
35
36 integer(kind=c_int) :: response
37
38 character(len=40) :: msg(1)
39
40 msg(1) = "本当に終了しますか?"
41
42 response = hl_gtk_message_dialog_show(msg, GTK_BUTTONS_YES_NO, &
43 & "終了"//c_null_char, parent=window)
44
45 if(response == GTK_RESPONSE_YES) then
46 call gtk_main_quit()
47 endif
48
49 endsubroutine cb_quit
50endmodule gui_handler
51
52!
53! main program
54!
55program sample
56 use gui_handler
57 implicit none
58
59 ! init GUI
60 call gtk_init()
61
62 ! create main window
63 window = hl_gtk_window_new("サンプル"//c_null_char, &
64 & wsize=(/200, 200/), &
65 & destroy=c_funloc(gtk_main_quit), &
66 & border=10_c_int)
67
68 ! verticall box
69 vbox = hl_gtk_box_new(horizontal=FALSE, &
70 & homogeneous=FALSE, &
71 & spacing=10_c_int)
72 call gtk_container_add(window, vbox)
73
74 ! horizontal box in a vertical box
75 hbox = hl_gtk_box_new(horizontal=TRUE, &
76 & homogeneous=TRUE, &
77 & spacing=10_c_int)
78 call hl_gtk_box_pack(vbox, hbox, expand=FALSE, atend=TRUE)
79
80 ! add button for a message dialog_
81 btn_msg = hl_gtk_button_new("メッセージ"//c_null_char,&
82 & clicked=c_funloc(cb_msg))
83 call hl_gtk_box_pack(hbox, btn_msg, expand=FALSE)
84
85 ! add button for quit
86 btn_quit = hl_gtk_button_new("終了"//c_null_char,&
87 & clicked=c_funloc(cb_quit))
88 call hl_gtk_box_pack(hbox, btn_quit, expand=FALSE)
89
90 ! now start app
91 call gtk_widget_show_all(window)
92 call gtk_main()
93
94 stop
95endprogram sample