-
Notifications
You must be signed in to change notification settings - Fork 43
/
hl_textview.f90
215 lines (160 loc) · 6.38 KB
/
hl_textview.f90
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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
! Contributed jtappin.
! Last modification: vmagnin+Ian Harvey, 2020-02-03
module handlers
use, intrinsic :: iso_c_binding
use gtk_hl
use gtk, only: gtk_main, gtk_main_quit, &
& gtk_widget_show, gtk_init, gtk_entry_get_text_length, &
& gtk_entry_get_text, gtk_text_iter_get_text
use g, only: g_object_unref
implicit none
type(c_ptr) :: win, zedt, contain, qbut, box, entry, box2, &
& abut, ibut, clbut, infobut
contains
subroutine my_destroy(widget, gdata) bind(c)
type(c_ptr), value :: widget, gdata
print *, "Exit called"
call gtk_main_quit ()
end subroutine my_destroy
subroutine tv_change(widget, gdata) bind(c)
type(c_ptr), value :: widget, gdata
integer(kind=c_int) :: nl, nc
integer(kind=c_int), dimension(:), allocatable :: ncl
print *, "CHANGED event"
call hl_gtk_text_view_get_info(C_NULL_PTR, buffer=widget, nlines=nl, &
& nchars=nc, ncline=ncl)
print *, nl, nc
print *, ncl
deallocate(ncl)
end subroutine tv_change
subroutine tv_ins(widget,iter, text, nins, gdata) bind(c)
type(c_ptr), value :: widget, gdata
type(c_ptr), value :: iter, text
integer(kind=c_int), value :: nins
integer(kind=c_int) :: nl, nc
integer(kind=c_int), dimension(:), allocatable :: ncl
character(kind=c_char), dimension(:), pointer :: cf_text
character(len=100), dimension(:), allocatable :: f_text
print *, "INSERT event", nins
call c_f_pointer(text, cf_text, (/ int(nins) /))
call convert_c_string(cf_text, f_text)
print "(a)", f_text
call hl_gtk_text_view_get_info(C_NULL_PTR, buffer=widget, nlines=nl, &
& nchars=nc, ncline=ncl)
print *, nl, nc
print *, ncl
end subroutine tv_ins
subroutine tv_del(widget, s_iter, e_iter, gdata) bind(c)
type(c_ptr), value :: widget, gdata
type(c_ptr), value :: s_iter, e_iter
type(c_ptr) :: ctext
character(len=100), dimension(:), allocatable :: ftext
integer(kind=c_int) :: dlen
print *, "DELETE event"
dlen = gtk_text_iter_get_offset(e_iter) - &
& gtk_text_iter_get_offset(s_iter)
ctext = gtk_text_iter_get_text(s_iter, e_iter)
call convert_c_string(ctext, ftext)
print "(A)", ftext(:)(:dlen)
deallocate(ftext)
end subroutine tv_del
subroutine tv_append(widget, gdata) bind(c)
type(c_ptr), value :: widget, gdata
character(len=40) :: ftext
call hl_gtk_entry_get_text(entry, ftext)
call hl_gtk_text_view_insert(zedt, (/ trim(ftext) /))
end subroutine tv_append
subroutine tv_insert(widget, gdata) bind(c)
type(c_ptr), value :: widget, gdata
character(len=40) :: ftext
call hl_gtk_entry_get_text(entry, ftext)
call hl_gtk_text_view_insert(zedt, (/ trim(ftext) /), at_cursor=TRUE)
end subroutine tv_insert
subroutine tv_clr(widget, gdata) bind(c)
type(c_ptr), value :: widget, gdata
call hl_gtk_text_view_delete(zedt)
end subroutine tv_clr
subroutine tv_info(widget, gdata) bind(c)
type(c_ptr), value :: widget, gdata
integer(kind=c_int), dimension(3) :: cursor, s_start, s_end
integer(kind=c_int) :: is_modified, has_select
cursor = hl_gtk_text_view_get_cursor(zedt)
has_select = hl_gtk_text_view_get_selection(zedt, &
& s_start, s_end)
is_modified = hl_gtk_text_view_get_modified(zedt)
print *, "Cursor: Line",cursor(1),"Column",cursor(2),"Offset",cursor(3)
if (has_select == TRUE) then
print *, "Selection Start: Line",s_start(1),"Column",s_start(2), &
& "Offset",s_start(3)
print *, "Selection End: Line",s_end(1),"Column",s_end(2),"Offset", &
& s_end(3)
else
print *, "No Selection"
end if
if (is_modified == TRUE) then
print *, "Modified"
else
print *, "Not modified"
end if
call hl_gtk_text_view_set_modified(zedt, FALSE)
end subroutine tv_info
subroutine entry_text(widget, gdata) bind(c)
type(c_ptr), value :: widget, gdata
integer(kind=c_int16_t) :: ntext
ntext = gtk_entry_get_text_length(widget)
if (ntext > 0) then
call gtk_widget_set_sensitive(abut, TRUE)
call gtk_widget_set_sensitive(ibut, TRUE)
else
call gtk_widget_set_sensitive(abut, FALSE)
call gtk_widget_set_sensitive(ibut, FALSE)
end if
end subroutine entry_text
end module handlers
program ztext
! ZTEXT
! Simple multiline text box example
use handlers
implicit none
! Initialize GTK
call gtk_init()
! Make a window and a vertical box
win = hl_gtk_window_new("Scrolling text"//c_null_char, destroy=c_funloc(my_destroy))
box = hl_gtk_box_new()
call gtk_container_add(win, box)
! Make a scrolling text box and put it in the box
zedt = hl_gtk_text_view_new(contain, editable=TRUE, &
& changed=c_funloc(tv_change), &
& insert_text=c_funloc(tv_ins), &
& delete_range=c_funloc(tv_del), &
& ssize=(/350_c_int, 200_c_int/), tooltip = &
& "Try typing, pasting or cutting text in here"//c_null_char)
call hl_gtk_box_pack(box, contain)
! Make a single line text entry, and buttons to append or place at cursor.
entry = hl_gtk_entry_new(60_c_int, editable=TRUE, tooltip = &
& "Enter text here, then click 'append' or 'insert'"//c_null_char, &
& changed=c_funloc(entry_text))
call hl_gtk_box_pack(box, entry, expand=FALSE)
box2 = hl_gtk_box_new(horizontal=TRUE)
call hl_gtk_box_pack(box, box2, expand=FALSE)
abut = hl_gtk_button_new("Append"//c_null_char, clicked=c_funloc(tv_append), &
& tooltip = "Add contents of entry box at end"//c_null_char, sensitive=FALSE)
call hl_gtk_box_pack(box2, abut)
ibut = hl_gtk_button_new("Insert"//c_null_char, clicked=c_funloc(tv_insert), &
& tooltip = "Add contents of entry box at cursor"//c_null_char, &
& sensitive=FALSE)
call hl_gtk_box_pack(box2, ibut)
! And a clear button, and an info button
infobut = hl_gtk_button_new("Information"//c_null_char, clicked=c_funloc(tv_info))
call hl_gtk_box_pack(box, infobut, expand=FALSE)
clbut = hl_gtk_button_new("Clear"//c_null_char, clicked=c_funloc(tv_clr))
call hl_gtk_box_pack(box, clbut, expand=FALSE)
! Make a quit button and put that in the box, then
! put the box in the window.
qbut = hl_gtk_button_new("Quit"//c_null_char, clicked=c_funloc(my_destroy))
call hl_gtk_box_pack(box, qbut, expand=FALSE)
! Realize the window
call gtk_widget_show_all(win)
! Event loop
call gtk_main()
end program ztext