Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 170 lines (137 sloc) 5.342 kb
1a9976d @jtappin Add infobar to high level code, and an example.
jtappin authored
1 ! Copyright (C) 2012
2 ! Free Software Foundation, Inc.
3
4 ! This file is part of the gtk-fortran GTK+ Fortran Interface library.
5
6 ! This is free software; you can redistribute it and/or modify
7 ! it under the terms of the GNU General Public License as published by
8 ! the Free Software Foundation; either version 3, or (at your option)
9 ! any later version.
10
11 ! This software is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU General Public License for more details.
15
16 ! Under Section 7 of GPL version 3, you are granted additional
17 ! permissions described in the GCC Runtime Library Exception, version
18 ! 3.1, as published by the Free Software Foundation.
19
20 ! You should have received a copy of the GNU General Public
21 ! License along with
22 ! this program; see the files COPYING3 and COPYING.RUNTIME respectively.
23 ! If not, see <http://www.gnu.org/licenses/>.
24 !
25 ! Contributed by James Tappin
26 ! Last modification: 08-30-2012
27
28
29 ! A demo of the HL infobar widget.
30
31 module ib_handers
32
33 use gtk_hl
34 use gtk, only: gtk_main, gtk_main_quit, gtk_widget_get_no_show_all, &
35 & gtk_widget_hide, gtk_widget_show_all, gtk_init, TRUE, FALSE, &
36 & GTK_FILL, GTK_MESSAGE_INFO, GTK_MESSAGE_WARNING, &
37 & GTK_MESSAGE_QUESTION, GTK_MESSAGE_ERROR, GTK_MESSAGE_OTHER
38
39 implicit none
40
41 type(c_ptr) :: tlwindow, infobar
42
43 enum, bind(c)
44 enumerator :: my_quit
45 enumerator :: my_no
46 enumerator :: my_yes
47 enumerator :: my_ok
48 enumerator :: my_print
49 enumerator :: my_ignore
50 end enum
51
52 contains
53 subroutine delete_h(widget, data) bind(c)
54 type(c_ptr), value :: widget, data
55
56 print *, "Exit called"
57 call gtk_main_quit()
58 end subroutine delete_h
59
60 subroutine response_h(widget, id, data) bind(c)
61 type(c_ptr), value :: widget, data
62 integer(kind=c_int), value :: id
63
64 select case(id)
65 case(my_quit)
66 print *, "Pressed 'QUIT'"
67 call gtk_main_quit()
68 return
69 case(my_yes)
70 print *, "Pressed 'YES'"
71 case(my_no)
72 print *, "Pressed 'NO'"
73 case(my_ok)
74 print *, "Pressed 'OK'"
75 case(my_ignore)
76 end select
77
78 if (c_f_logical(gtk_widget_get_no_show_all(widget))) &
79 & call gtk_widget_hide(widget)
80
81 end subroutine response_h
82
83 subroutine button_h(widget, data) bind(c)
84 type(c_ptr), value :: widget, data
85
86 integer(kind=c_int), pointer :: index
87 integer(kind=c_int), parameter, dimension(5) :: ids=[my_ok, my_yes, &
88 & my_no, my_ignore, my_quit]
89
90 call c_f_pointer(data, index)
91
92 select case (index)
93 case(0)
94 call hl_gtk_info_bar_message(infobar, &
95 & "For your informatation"//c_null_char, &
96 & type=GTK_MESSAGE_INFO, ids=ids, &
97 & state=[TRUE, FALSE, FALSE, TRUE, FALSE], &
98 & default=my_ok)
99 case(1)
100 call hl_gtk_info_bar_message(infobar, &
101 & "Take care"//c_null_char, &
102 & type=GTK_MESSAGE_WARNING, ids=ids, &
103 & state=[TRUE, FALSE, FALSE, TRUE, FALSE], &
104 & default=my_ignore)
105 case(2)
106 call hl_gtk_info_bar_message(infobar, &
107 & "This is BAD!!!!"//c_null_char, &
108 & type=GTK_MESSAGE_ERROR, ids=ids, &
109 & state=[FALSE, FALSE, FALSE, TRUE, TRUE], &
110 & default=my_quit)
111 case(3)
112 call hl_gtk_info_bar_message(infobar, &
113 & "Are you certain"//c_null_char, &
114 & type=GTK_MESSAGE_QUESTION, ids=ids, &
115 & state=[FALSE, TRUE, TRUE, TRUE, FALSE], &
116 & default=my_no)
117 case(4)
118 call hl_gtk_info_bar_message(infobar, &
119 & "Something else again"//c_null_char, &
120 & type=GTK_MESSAGE_OTHER, ids=ids, &
121 & state=[TRUE, FALSE, FALSE, TRUE, TRUE], &
122 & default=my_ignore)
123 end select
124 end subroutine button_h
125
126 end module ib_handers
127
128 program hl_infobar
129 use ib_handers
130 implicit none
131
132 integer(kind=c_int), dimension(5), target :: button_states = &
133 & [0,1,2,3,4]
134 type(c_ptr) :: jb, junk
135
136 call gtk_init()
137 tlwindow = hl_gtk_window_new("InfoBar Demo"//c_null_char, &
138 & destroy = c_funloc(delete_h), resizable=FALSE)
139
140 jb = hl_gtk_table_new()
141 call gtk_container_add(tlwindow, jb)
142
143 junk=hl_gtk_button_new("Info"//c_null_char, &
144 & clicked=c_funloc(button_h), data=c_loc(button_states(1)))
145 call hl_gtk_table_attach(jb, junk, 0, 0, yopts=0)
146 junk=hl_gtk_button_new("Warning"//c_null_char, &
147 & clicked=c_funloc(button_h), data=c_loc(button_states(2)))
148 call hl_gtk_table_attach(jb, junk, 1, 0, yopts=0)
149 junk=hl_gtk_button_new("Error"//c_null_char, &
150 & clicked=c_funloc(button_h), data=c_loc(button_states(3)))
151 call hl_gtk_table_attach(jb, junk, 2, 0, yopts=0)
152 junk=hl_gtk_button_new("Question"//c_null_char, &
153 & clicked=c_funloc(button_h), data=c_loc(button_states(4)))
154 call hl_gtk_table_attach(jb, junk, 3, 0, yopts=0)
155 junk=hl_gtk_button_new("Other"//c_null_char, &
156 & clicked=c_funloc(button_h), data=c_loc(button_states(5)))
157 call hl_gtk_table_attach(jb, junk, 4, 0, yopts=0)
158
159 infobar = hl_gtk_info_bar_new(buttons=&
160 & [character(len=6) :: 'OK','Yes','No','Ignore','Quit'], &
161 & ids=[my_ok, my_yes, my_no, my_ignore, my_quit], &
162 & response=c_funloc(response_h), horizontal=TRUE, buttons_below=TRUE)
163
164 call hl_gtk_table_attach(jb,infobar,0,1, xspan=5, yopts=0)
165
166 call gtk_widget_show_all (tlwindow)
167 call gtk_main()
168
169 end program hl_infobar
Something went wrong with that request. Please try again.