Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 113 lines (88 sloc) 3.581 kB
ab31f40 examples/hl_list1.f90: added
James Tappin authored
1 ! Copyright (C) 2011
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 License along with
21 ! this program; see the files COPYING3 and COPYING.RUNTIME respectively.
22 ! If not, see <http://www.gnu.org/licenses/>.
23 !
24 ! gfortran -g gtk.f90 gtk-sup.f90 gtk-hl.f90 hl_pbar.f90 `pkg-config --cflags --libs gtk+-2.0`
25 ! Contributed by James Tappin.
26
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
27 module handlers
ab31f40 examples/hl_list1.f90: added
James Tappin authored
28 use gtk_hl
e3dfe54 modified: examples/hl_dialog.f90: Update for GTK3 compatibility
James Tappin authored
29 use gtk, only: gtk_button_new, gtk_container_add, gtk_events_pending, gtk_main,&
2d5819d @jtappin examples/hl_dialog.f90: Replace deprecated calls.
jtappin authored
30 & gtk_main_iteration, gtk_main_iteration_do, gtk_main_quit, gtk_widget_destroy,&
e3dfe54 modified: examples/hl_dialog.f90: Update for GTK3 compatibility
James Tappin authored
31 & gtk_progress_bar_new, gtk_widget_show, gtk_widget_show_all, gtk_window_new, &
32 & gtk_init
33
57875a0 @vmagnin * compilation acceleration.
vmagnin authored
34 use g, only: g_usleep
ab31f40 examples/hl_list1.f90: added
James Tappin authored
35
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
36 implicit none
37
ab31f40 examples/hl_list1.f90: added
James Tappin authored
38 type(c_ptr) :: win,bar,pbar,qbut, box
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
39 integer(kind=c_int) :: run_status = TRUE
40
41 contains
ab31f40 examples/hl_list1.f90: added
James Tappin authored
42 subroutine my_destroy(widget, gdata) bind(c)
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
43 type(c_ptr), value :: widget, gdata
44 print *, "Exit called"
2d5819d @jtappin examples/hl_dialog.f90: Replace deprecated calls.
jtappin authored
45 ! call gtk_widget_destroy(win)
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
46 ! call gtk_main_quit ()
47 run_status = FALSE
48 end subroutine my_destroy
49
50 subroutine pending_events ()
ab31f40 examples/hl_list1.f90: added
James Tappin authored
51 integer(c_int) :: boolresult
52 do
53 if (IAND(gtk_events_pending(), run_status) == FALSE) exit
54 boolresult = gtk_main_iteration_do(FALSE) ! False for non-blocking
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
55 end do
56 end subroutine pending_events
57
58 end module handlers
59
60 program progress
61
62 ! PROGRESS
63 ! Examples of progress bars
64
65 use handlers
66
67 implicit none
68
69 integer :: t0, t1, istep
70 real(kind=c_double) :: bval
71
72 ! Initialize gtk & create a window for the heirarchy
73 call gtk_init()
5683e79 @jtappin * Replace CNULL etc. with c_null_char etc. in gtk_sup and hl examples.
jtappin authored
74 win = hl_gtk_window_new("Progress"//c_null_char, destroy=c_funloc(my_destroy))
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
75
76 ! Make a column box to contain our widgets and put it in the window
e3dfe54 modified: examples/hl_dialog.f90: Update for GTK3 compatibility
James Tappin authored
77 box=hl_gtk_box_new()
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
78 call gtk_container_add(win, box)
79
80 ! Make 2 horizontal progress bars and put them in the box
ab31f40 examples/hl_list1.f90: added
James Tappin authored
81 bar = hl_gtk_progress_bar_new()
e3dfe54 modified: examples/hl_dialog.f90: Update for GTK3 compatibility
James Tappin authored
82 call hl_gtk_box_pack(box, bar)
ab31f40 examples/hl_list1.f90: added
James Tappin authored
83 pbar = hl_gtk_progress_bar_new(step=0.05_c_double)
e3dfe54 modified: examples/hl_dialog.f90: Update for GTK3 compatibility
James Tappin authored
84 call hl_gtk_box_pack(box, pbar)
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
85
86 ! Make a quit button and put that in the box.
5683e79 @jtappin * Replace CNULL etc. with c_null_char etc. in gtk_sup and hl examples.
jtappin authored
87 qbut = hl_gtk_button_new("Quit"//c_null_char, clicked=c_funloc(my_destroy))
e3dfe54 modified: examples/hl_dialog.f90: Update for GTK3 compatibility
James Tappin authored
88 call hl_gtk_box_pack(box, qbut)
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
89
90 ! Display the window
91 call gtk_widget_show_all(Win)
92
93 ! Get the epoch in milliseconds and start a counter
94 call system_clock(t0)
95 istep = 0
96
97 ! event loop
98 do
99 call pending_events()
100 if (run_status == FALSE) exit
101 call g_usleep(10000_c_long) ! So we don't burn CPU cycles
102 istep = istep+1
103 call system_clock(t1)
104 bval = real(t1-t0,c_double)/10000.
105 if (bval > 1._c_double) exit
ab31f40 examples/hl_list1.f90: added
James Tappin authored
106 call hl_gtk_progress_bar_set(bar, bval, string=TRUE)
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
107 if (mod(istep, 20) == 0) &
5683e79 @jtappin * Replace CNULL etc. with c_null_char etc. in gtk_sup and hl examples.
jtappin authored
108 & call hl_gtk_progress_bar_set(pbar, text="Working"//c_null_char)
ab31f40 examples/hl_list1.f90: added
James Tappin authored
109 ! There's an issue with string arguments in overloaded procedures
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
110 end do
2d5819d @jtappin examples/hl_dialog.f90: Replace deprecated calls.
jtappin authored
111 call gtk_widget_destroy(Win)
4b0de46 Committer: James Tappin <james@amarice.(none)>
James Tappin authored
112 end program progress
Something went wrong with that request. Please try again.