Skip to content
This repository
tree: 61c5b76b96
Fetching contributors…

Cannot retrieve contributors at this time

file 378 lines (301 sloc) 13.678 kb
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 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
! Copyright (C) 2011
! Free Software Foundation, Inc.

! This file is part of the gtk-fortran gtk+ Fortran Interface library.

! This is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 3, or (at your option)
! any later version.

! This software is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.

! Under Section 7 of GPL version 3, you are granted additional
! permissions described in the GCC Runtime Library Exception, version
! 3.1, as published by the Free Software Foundation.

! You should have received a copy of the GNU General Public License along with
! this program; see the files COPYING3 and COPYING.RUNTIME respectively.
! If not, see <http://www.gnu.org/licenses/>.
!
! gfortran -g hl_list_renderers.90 `pkg-config --cflags --libs gtk-2-fortran`
! Contributed by James Tappin.

module ln_handlers
  use gtk_hl
  use gtk, only: gtk_button_new, gtk_check_button_new, gtk_container_add, gtk_ent&
       &ry_get_text, gtk_entry_get_text_length, gtk_entry_new, gtk_entry_set_text, gtk&
       &_main, gtk_main_quit, gtk_widget_destroy, gtk_toggle_button_get_active, gtk_to&
       &ggle_button_set_active, gtk_widget_show, gtk_widget_show_all, gtk_window_new, &
       & gtk_init, GTK_POLICY_NEVER
  use g, only: alloca, g_object_set_property

  use gdk_pixbuf_hl

  implicit none

  ! The widgets. (Strictly only those that need to be accessed
  ! by the handlers need to go here).

  type(c_ptr) :: ihwin,ihscrollcontain,ihlist, base, &
       & qbut, lbl

contains
subroutine my_destroy(widget, gdata) bind(c)
    type(c_ptr), value :: widget, gdata
    print *, "Exit called"
    call gtk_widget_destroy(ihwin)
    call gtk_main_quit ()
  end subroutine my_destroy

  subroutine list_select(list, gdata) bind(c)
    type(c_ptr), value :: list, gdata

    integer, pointer :: fdata
    integer(kind=c_int) :: nsel
    integer(kind=c_int), dimension(:), allocatable :: selections
    real(kind=c_double) :: x, x3
    integer(kind=c_int64_t) :: n4
    real(kind=c_float) :: nlog
    character(len=30) :: name
    character(len=10) :: nodd
    character :: code
    type(c_ptr) :: pixbuf
    integer(kind=c_short), dimension(:,:,:), allocatable :: pixels

    nsel = hl_gtk_listn_get_selections(C_NULL_PTR, selections, list)
    if (nsel == 0) then
print *, "No selection"
       return
end if

    ! Find and print the selected row(s)
    print *, nsel,"Rows selected"
    print *, selections
    if (nsel == 1) then
call hl_gtk_listn_get_cell(ihlist, selections(1), 0, svalue=name)
       call hl_gtk_listn_get_cell(ihlist, selections(1), 1, dvalue=x)
       call hl_gtk_listn_get_cell(ihlist, selections(1), 2, dvalue=x3)
       call hl_gtk_listn_get_cell(ihlist, selections(1), 4, l64value=n4)
       call hl_gtk_listn_get_cell(ihlist, selections(1), 3, fvalue=nlog)
       call hl_gtk_listn_get_cell(ihlist, selections(1), 5, svalue=nodd)
       call hl_gtk_listn_get_cell(ihlist, selections(1), 6, svalue=code)
       call hl_gtk_listn_get_cell(ihlist, selections(1), 8, pbvalue=pixbuf)
       call hl_gdk_pixbuf_get_pixels(pixbuf, pixels)
       print "('Row:',I3,' Name: ',a,' X:',F7.2,' 3X:',F7.2,' X**4:',I7,&
&' log(n):',F7.5,' Odd?: ',a, ' Code:',a)", &
            & selections(1), trim(name), x, x3, n4, nlog, nodd, code
       print *, "Pixels: ", pixels(:,3,3)
    end if

deallocate(selections)
  end subroutine list_select

  subroutine cell_edited(renderer, path, text, gdata) bind(c)
    type(c_ptr), value :: renderer, path, text, gdata

    ! Callback for edited cells.

    character(len=200) :: fpath, ftext
    integer(kind=c_int) :: irow
    integer(kind=c_int), pointer :: icol
    integer :: ios
    type(c_ptr) :: pcol, list
    real(kind=c_double) :: x

    call convert_c_string(path, 200, fpath)
    read(fpath, *) irow
    pcol = g_object_get_data(renderer, "column-number"//c_null_char)
    call c_f_pointer(pcol, icol)
    call convert_c_string(text, 200, ftext)
    list = g_object_get_data(renderer, "view"//c_null_char)

    print *, "Edit in column", icol

    if (icol == 0) then
call hl_gtk_listn_set_cell(list, irow, icol, &
            & svalue=trim(ftext))
    else
read(ftext, *, iostat=ios) x
       if (ios /= 0) return
call hl_gtk_listn_set_cell(ihlist, irow, 2, dvalue=3*x)
       call hl_gtk_listn_set_cell(ihlist, irow, 3, dvalue=log10(x))
       call hl_gtk_listn_set_cell(ihlist, irow, 4, &
            & l64value=int(x**4,c_int64_t))
       call hl_gtk_listn_set_cell(ihlist, irow, 5, ivalue=mod(int(x),2))
       call hl_gtk_listn_set_cell(ihlist, irow, 7, ivalue=mod(int(3*x),100))
       call hl_gtk_listn_set_cell(ihlist, irow, 1, dvalue=x)
    end if
end subroutine cell_edited

  subroutine ccell_edit(renderer, path, text, gdata) bind(c)
    type(c_ptr), value :: renderer, path, text, gdata

    ! Basic callback to report what's called
    character(len=200) :: fpath, ftext
    integer(kind=c_int) :: irow

    call c_f_string(path, len(fpath), fpath)
    call c_f_string(text, len(ftext), ftext)
    read(fpath, *) irow

    print *, "Combo sent edited signal from ", trim(fpath)
    print *, "Text was ", trim(ftext)
    call hl_gtk_listn_set_cell(ihlist, irow, 9, svalue=trim(ftext))

  end subroutine ccell_edit
  subroutine ccell_changed(renderer, path, iter, gdata) bind(c)
    type(c_ptr), value :: renderer, path, iter, gdata

    ! Basic callback to report what's called

    character(len=200) :: fpath

    call c_f_string(path, len(fpath), fpath)
    print *, "Combo sent changed signal from ", trim(fpath)

  end subroutine ccell_changed

  
  subroutine cell_clicked(renderer, path, gdata) bind(c)
    type(c_ptr), value :: renderer, path, gdata

    character(len=200) :: fpath
    integer(kind=c_int) :: irow
    integer(kind=c_int), pointer :: icol
    integer :: ios
    type(c_ptr) :: pcol, list
    logical :: state

    call convert_c_string(path, 200, fpath)
    read(fpath, *) irow

    pcol = g_object_get_data(renderer, "column-number"//c_null_char)
    call c_f_pointer(pcol, icol)

    list = g_object_get_data(renderer, "view"//c_null_char)

    state = c_f_logical(gtk_cell_renderer_toggle_get_active(renderer))

    print *, "Changed state in row", irow, " to ", .not. state

    call hl_gtk_listn_set_cell(list, irow, icol, &
         & logvalue= .not. state)

  end subroutine cell_clicked
  subroutine rcell_clicked(renderer, path, gdata) bind(c)
    type(c_ptr), value :: renderer, path, gdata

    ! Default callback for a toggle button in a list
    !
    ! RENDERER: c_ptr: required: The renderer which sent the signal
    ! PATH: c_ptr: required: The path at which to insert
    ! GDATA: c_ptr: required: User data, Not used.
    !
    ! The column number is passed via the "column-number" gobject data value.
    ! The treeview containing the cell is passed via the "view" gobject
    ! data value.
    ! The row number is passed as a string in the PATH argument.
    ! This routine is not normally called by the application developer.
    !-
    character(len=200) :: fpath
    integer(kind=c_int) :: irow
    integer(kind=c_int), pointer :: icol
    integer :: ios, i
    type(c_ptr) :: pcol, list
    logical :: state
    integer(kind=c_int) :: nrows

    call convert_c_string(path, 200, fpath)
    read(fpath, *) irow

    pcol = g_object_get_data(renderer, "column-number"//c_null_char)
    call c_f_pointer(pcol, icol)

    list = g_object_get_data(renderer, "view"//c_null_char)

    state = c_f_logical(gtk_cell_renderer_toggle_get_active(renderer))
    print *, irow, state

    if (state) return ! Don't act on an unset

    ! Find the first iterator
    nrows = gtk_tree_model_iter_n_children (gtk_tree_view_get_model(list), &
         & c_null_ptr)
    do i = 0,nrows-1
       call hl_gtk_listn_set_cell(list, i, icol, &
            & logvalue= i == irow)
    end do
end subroutine rcell_clicked

  subroutine display_dbl(col, cell, model, iter, data) bind(c)
    type(c_ptr), value :: col, cell, model, iter, data

    ! Formatting routine attached via hl_gtk_listn_set_cell_data_func
    ! Note that the column index is passed via the DATA argument, so
    ! far as I can see the only other way is to use constants.

    character(len=20) :: rstring
    real(kind=c_double) :: dval
    type(gvalue), target :: dvalue, svalue
    type(c_ptr) :: val_ptr
    integer(kind=c_int), pointer :: colno

    call c_f_pointer(data, colno)

    call gtk_tree_model_get_value(model, iter, colno, c_loc(dvalue))
    dval = g_value_get_double(c_loc(dvalue))

    write(rstring, "(f0.1)") dval

    val_ptr = c_loc(svalue)
    val_ptr = g_value_init(val_ptr, G_TYPE_STRING)

    call g_value_set_string(val_ptr, trim(rstring)//c_null_char)
    call g_object_set_property(cell, "text"//c_null_char, val_ptr)
  end subroutine display_dbl
end module ln_handlers

program list_rend
  ! LIST_REND
  ! Demo of multi column list, with renderers

  use ln_handlers

  implicit none

integer, parameter :: ncols = 11, nrows=10
  character(len=35) :: line
  integer :: i, ltr
  integer, target :: iappend=0, idel=0
  integer(kind=type_kind), dimension(ncols) :: ctypes
  character(len=20), dimension(ncols) :: titles, renderers
  integer(kind=c_int), dimension(ncols) :: editable
  integer(kind=c_int), dimension(ncols) :: widths
  integer(kind=c_int), dimension(2), target :: fmt_col = [1, 2]
  integer(kind=c_short), dimension(3, 100, 24) :: image
  integer(kind=c_short), dimension(nrows) :: red, green, blue
  type(c_ptr) :: pixbuf

  red = [0, 255, 255, 0, 0, 0, 255, 255, 85, 170]
  green = [0, 255, 0, 255, 0, 255, 0, 255, 85, 170]
  blue = [0, 255, 0, 0, 255, 255, 255, 0, 85, 170]

  ! Initialize GTK+
  call gtk_init()

  ! Create a window that will hold the widget system
  ihwin=hl_gtk_window_new('Renderers list demo'//c_null_char, &
       & destroy=c_funloc(my_destroy))

  ! Now make a column box & put it into the window
  base = hl_gtk_box_new()
  call gtk_container_add(ihwin, base)

  ! Now make a multi column list with multiple selections enabled
  ctypes = (/ G_TYPE_STRING, G_TYPE_DOUBLE, G_TYPE_DOUBLE, G_TYPE_DOUBLE, &
       & G_TYPE_UINT64, G_TYPE_BOOLEAN, G_TYPE_BOOLEAN, G_TYPE_INT,&
       & gdk_pixbuf_get_type(), G_TYPE_STRING , G_TYPE_BOOLEAN /)
  editable = (/ TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, &
       & FALSE, TRUE, TRUE /)
  widths = [-1, -1, -1, -1, -1, -1, -1, 150, -1, -1, -1]

  titles = (/ character(len=20) :: "Name", "N", "3N", "Log(n)", &
       & "N**4", "Odd?", "Select?", "Fraction", "Colour", "Choose", "Pick" /)
  renderers = (/ hl_gtk_cell_text, hl_gtk_cell_spin, hl_gtk_cell_text, &
       & hl_gtk_cell_text, hl_gtk_cell_text, hl_gtk_cell_text,&
       & hl_gtk_cell_toggle, hl_gtk_cell_progress, hl_gtk_cell_pixbuf, &
       & hl_gtk_cell_combo, hl_gtk_cell_radio /)

  ihlist = hl_gtk_listn_new(ihscrollcontain, types=ctypes, &
       & changed=c_funloc(list_select),&
       & multiple=TRUE, titles=titles, width=widths, &
       & renderers=renderers, editable=editable, &
       & edited=c_funloc(cell_edited), hscroll_policy=GTK_POLICY_NEVER,&
       & vscroll_policy=GTK_POLICY_NEVER, toggled=c_funloc(cell_clicked), &
       & toggled_radio=c_funloc(rcell_clicked), &
       & edited_combo=c_funloc(ccell_edit), &
       & changed_combo=c_funloc(ccell_changed))

  call hl_gtk_listn_config_spin(ihlist, 1_c_int, vmax = huge(1._c_double), &
       & step = 0.1_c_double, digits=1)
  call hl_gtk_listn_config_combo(ihlist, 9_c_int, &
       & vals=['one ', 'two ', 'three'], &
       & has_entry=FALSE)

  do i = 1, size(fmt_col)
     call hl_gtk_listn_set_cell_data_func(ihlist, fmt_col(i), &
          & func=c_funloc(display_dbl), &
          & data=c_loc(fmt_col(i)))
  end do
  ! Now put <nrows> rows into it
  do i=1,nrows
     call hl_gtk_listn_ins(ihlist)
     write(line,"('List entry number ',I0)") i
     ltr=len_trim(line)+1
     line(ltr:ltr)=c_null_char
call hl_gtk_listn_set_cell(ihlist, i-1, 0, svalue=line)
     call hl_gtk_listn_set_cell(ihlist, i-1, 1, dvalue=real(i, c_double))
     call hl_gtk_listn_set_cell(ihlist, i-1, 2, dvalue=real(3*i, c_double))
     call hl_gtk_listn_set_cell(ihlist, i-1, 3, fvalue=log10(real(i)))
     call hl_gtk_listn_set_cell(ihlist, i-1, 4, l64value=int(i, c_int64_t)**4)
     call hl_gtk_listn_set_cell(ihlist, i-1, 5, ivalue=mod(i,2))
     call hl_gtk_listn_set_cell(ihlist, i-1, 6, logvalue=mod(i,3) == 0)
     call hl_gtk_listn_set_cell(ihlist, i-1, 7, ivalue=mod(3*i, 100))
     image(1,:,:) = red(i)
     image(2,:,:) = green(i)
     image(3,:,:) = blue(i)
     pixbuf = hl_gdk_pixbuf_new(image)
     call hl_gtk_listn_set_cell(ihlist, i-1, 8, pbvalue=pixbuf)
     call hl_gtk_listn_combo_set_select(ihlist, i-1, 9_c_int, &
          & selection=mod(i,3))
     call hl_gtk_listn_set_cell(ihlist, i-1, 10, logvalue= i==4)
  end do

  ! It is the scrollcontainer that is placed into the box.
  call hl_gtk_box_pack(base, ihscrollcontain)

  ! Add a note about editable columns
  lbl = gtk_label_new('The "Name", "N" and "Select?" columns are editable'&
       &//c_null_char)
  call hl_gtk_box_pack(base, lbl)

  ! Also a quit button
  qbut = hl_gtk_button_new("Quit"//c_null_char, clicked=c_funloc(my_destroy))
  call hl_gtk_box_pack(base,qbut)

  ! realize the window

  call gtk_widget_show_all(ihwin)

  ! Event loop

  call gtk_main()

end program list_rend
Something went wrong with that request. Please try again.