Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 145 lines (108 sloc) 4.698 kB
d3d7011 new file: examples/hl_sliders.f90
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 ! Contributed by James Tappin.
25
26 module handlers
27 use gtk_hl
28 use gtk, only: gtk_button_new, gtk_container_add, gtk_main, gtk_main_quit, gtk_&
29 &spin_button_get_value, gtk_spin_button_new, gtk_spin_button_set_value, gtk_wid&
30 &get_destroy, gtk_widget_show, gtk_widget_show_all, gtk_window_new, &
31 & TRUE, FALSE, gtk_init
32
33 implicit none
34 type(c_ptr) :: base, box, slid, islid, win, qbut, spin,&
35 & ispin
36
37 contains
38 subroutine my_destroy(widget, gdata) bind(c)
39 type(c_ptr), value :: widget, gdata
40 print *, "Exit called"
41 call gtk_widget_destroy(win)
42 call gtk_main_quit ()
43 end subroutine my_destroy
44
45 subroutine slider1(widget, gdata) bind(c)
46 type(c_ptr), value :: widget, gdata
47 ! Moved the float slider, set the int spinner and report
48
49 real(kind=c_double) :: val
50
51 val = hl_gtk_slider_get_value(widget)
52 print *, "FP slider moved to", val
53 call hl_gtk_spin_button_set_value(spin, val)
54 end subroutine slider1
55
56 subroutine slider2(widget, gdata) bind(c)
57 type(c_ptr), value :: widget, gdata
58 ! Moved the int slider, set the int spinner and report
59
60 integer(kind=c_int) :: ival
61
62 ival = hl_gtk_slider_get_value(widget)
63 print *, 'INT slider moved to', ival
64 call hl_gtk_spin_button_set_value(ispin, ival)
65 end subroutine slider2
66
67
68 subroutine spinner1(widget, gdata) bind(c)
69 type(c_ptr), value :: widget, gdata
70 ! Moved the FP spinner, set the FP slider & report
71
72 real(kind=c_double) :: val
73
74 val = hl_gtk_spin_button_get_value(widget)
75 print *, "FP spinner moved to", val
76 call hl_gtk_slider_set_value(slid, val)
77 end subroutine spinner1
78
79 subroutine spinner2(widget, gdata) bind(c)
80 type(c_ptr), value :: widget, gdata
81 ! Move the int spinner, set the int slider & report
82
83 integer(kind=c_int) :: ival
84
85 ival = hl_gtk_spin_button_get_value(widget)
86 print *, 'INT spinner moved to', ival
87 call hl_gtk_slider_set_value(islid, ival)
88 end subroutine spinner2
89
90 end module handlers
91
92 program sliders
93
94 ! SLIDERS
95 ! Demo of sliders & spin buttons
96
97 use handlers
98
99 implicit none
100
101 ! Initialize gtk
102 call gtk_init()
103
104 ! Create a window and 2 boxes, one horizontal,one vertical
5683e79 @jtappin * Replace CNULL etc. with c_null_char etc. in gtk_sup and hl examples.
jtappin authored
105 win = hl_gtk_window_new("Sliders demo"//c_null_char, destroy=c_funloc(my_destroy))
d3d7011 new file: examples/hl_sliders.f90
James Tappin authored
106 base = hl_gtk_box_new()
107 call gtk_container_add(win, base)
108 box = hl_gtk_box_new(horizontal=TRUE, homogeneous=TRUE)
109 call hl_gtk_box_pack(base, box)
110
111 ! make a floating point vertical slider with a range 0-10 and step 0.1
112 ! put it in the horizontal box
113 slid = hl_gtk_slider_new(0._c_double, 10._c_double, 0.1_c_double, &
114 & vertical = TRUE, value_changed=c_funloc(slider1), length=200)
115 call hl_gtk_box_pack(box, slid)
116
117 ! Now an integer slider from 0-64 and put it in the horizontal box
118 islid = hl_gtk_slider_new(0, 64, vertical=TRUE, &
119 & value_changed=c_funloc(slider2), length=200)
120 call hl_gtk_box_pack(box, islid)
121
122 ! Make a spin button with range 0-10 and step 0.1 and put it in
123 ! the vertical box
124 spin = hl_gtk_spin_button_new(0._c_double, 10._c_double, 0.1_c_double, &
125 & value_changed=c_funloc(spinner1))
126 call hl_gtk_box_pack(base, spin)
127
128 ! Make an integer spin button with range from 0-64 and put it in the
129 ! vertical box
130 ispin = hl_gtk_spin_button_new(0, 64, value_changed=c_funloc(spinner2), &
131 & wrap=TRUE)
132 call hl_gtk_box_pack(base, ispin)
133
134 ! Finally make a quit button, put that in the vertical box and put
135 ! the vertical box in the window.
136
5683e79 @jtappin * Replace CNULL etc. with c_null_char etc. in gtk_sup and hl examples.
jtappin authored
137 qbut = hl_gtk_button_new("Quit"//c_null_char, clicked=c_funloc(my_destroy))
d3d7011 new file: examples/hl_sliders.f90
James Tappin authored
138 call hl_gtk_box_pack(base, qbut)
139
140 ! Realize the hierarchy
141 call gtk_widget_show_all(win)
142 call gtk_main
143
144 end program sliders
Something went wrong with that request. Please try again.