Permalink
Browse files

Improvements to gtk_draw_hl

     Add region support to ...get_gdk_pixbuf
     use gdk routine for this in g[td]k 3
     remove obsolete code

     Add example of pixbuf reading to hl_cairo1
     remove redundant code from graphics examples.
  • Loading branch information...
1 parent 3e53bc7 commit aa5ed68830b585f3f7203b9875e9d04aa22080cf @jtappin jtappin committed Jan 21, 2013
Showing with 394 additions and 260 deletions.
  1. +85 −47 examples/hl_cairo1.f90
  2. +0 −1 examples/hl_cairo_clock.f90
  3. +0 −1 plplot/hl_plplot17e.f90
  4. +175 −126 src/gtk-draw-hl-tmpl.f90
  5. +134 −85 src/gtk-draw-hl.f90
View
@@ -27,75 +27,112 @@
module handlers
use iso_c_binding
-
- use gtk, only: gtk_container_add, gtk_drawing_area_new, gtk_events_pending, gtk&
- &_main, gtk_main_iteration, gtk_main_iteration_do, gtk_widget_get_window, gtk_w&
- &idget_show, gtk_window_new, gtk_window_set_default, gtk_window_set_default_siz&
- &e, gtk_window_set_title, gtk_widget_show_all, gtk_main_quit, &
- & gtk_widget_queue_draw, &
- & TRUE, FALSE, GTK_WINDOW_TOPLEVEL, gtk_init, g_signal_connect, &
- & CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_NORMAL, gtk_event_box_new, &
- & GDK_ENTER_NOTIFY, GDK_LEAVE_NOTIFY, GDK_2BUTTON_PRESS, GDK_KEY_RELEASE, &
- & GDK_CONTROL_MASK, GDK_POINTER_MOTION_MASK, GDK_BUTTON_PRESS, &
- & GDK_BUTTON_MOTION_MASK, &
- & GDK_KEY_PRESS, GDK_POINTER_MOTION_HINT_MASK, GDK_ALL_EVENTS_MASK
-
- use cairo, only: cairo_arc, cairo_create, cairo_curve_to, cairo_destroy, cairo_&
- &get_target, cairo_line_to, cairo_move_to, cairo_new_sub_path, cairo_select_fon&
- &t_face, cairo_set_font_size, cairo_set_line_width, cairo_set_source, cairo_set&
- &_source_rgb, cairo_show_text, cairo_stroke, cairo_surface_write_to_png, &
- & cairo_paint, cairo_rectangle
-
- use gdk, only: gdk_cairo_create, gdk_keyval_from_name, gdk_keyval_name, &
- & gdk_cairo_set_source_window, gdk_device_get_name, &
- & gdk_device_get_source
- use g, only: g_usleep
+
+ !********************************
+ ! Gtk modules for hl_cairo1.f90
+ use cairo, only: cairo_arc, cairo_curve_to, cairo_get_target, &
+ & cairo_line_to, cairo_move_to, cairo_new_sub_path, cairo_paint, &
+ & cairo_rectangle, cairo_select_font_face, cairo_set_font_size, &
+ & cairo_set_line_width, cairo_set_source_rgb, cairo_show_text, &
+ & cairo_stroke, cairo_surface_write_to_png
+
+ use gdk, only: gdk_device_get_name, gdk_device_get_source, &
+ & gdk_keyval_from_name, gdk_keyval_name
+
+ use gtk, only: gtk_container_add, gtk_main, gtk_main_quit, &
+ & gtk_widget_queue_draw, gtk_widget_show_all, gtk_init, TRUE, FALSE, &
+ & CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_NORMAL, GDK_BUTTON_PRESS, &
+ & GDK_2BUTTON_PRESS, GDK_BUTTON_RELEASE, GDK_KEY_PRESS, &
+ & GDK_ENTER_NOTIFY, GDK_LEAVE_NOTIFY, GDK_POINTER_MOTION_MASK, &
+ & GDK_BUTTON_MOTION_MASK, GDK_CONTROL_MASK, GDK_RELEASE_MASK
+
use gdk_events
+ use gdk_pixbuf_hl
use gtk_draw_hl
use gtk_sup
use gtk_hl
implicit none
-! integer(c_int) :: run_status = TRUE
+ ! integer(c_int) :: run_status = TRUE
integer(c_int) :: boolresult
logical :: boolevent
integer(kind=c_int) :: width, height
-
+
+ logical :: rflag = .false.
+ integer(kind=c_int) :: xp0, yp0
+
contains
! User defined event handlers go here
function delete_h (widget, event, gdata) result(ret) bind(c)
use iso_c_binding, only: c_ptr, c_int
integer(c_int) :: ret
type(c_ptr), value :: widget, event, gdata
-! run_status = FALSE
+ ! run_status = FALSE
call gtk_main_quit
ret = FALSE
end function delete_h
- function button_event_h(widget, event, gdata) result(rv) bind(c)
+ function button_event_h(widget, event, gdata) result(rv) bind(c)
integer(kind=c_int) :: rv
type(c_ptr), value, intent(in) :: widget, event, gdata
-
+
type(gdkeventbutton), pointer :: bevent
- type(c_ptr) :: dcname
+ type(c_ptr) :: dcname, pixb
character(len=64) :: dname
+ integer(kind=c_int) :: xp1, yp1, xo, yo, xs, ys, ipick
+ character(len=120), dimension(:), allocatable :: files
- print *, "Button press detected"
if (c_associated(event)) then
call c_f_pointer(event,bevent)
+ else
+ return
+ end if
+
+ if (bevent%type == GDK_BUTTON_RELEASE) then
+ print *, "Button release detected"
+ if (rflag) then
+ xp1 = nint(bevent%x)
+ yp1 = nint(bevent%y)
+ print *, "Corners: ", xp0, yp0, " and ", xp1, yp1
+
+ xo = min(xp0, xp1)
+ yo = min(yp0, yp1)
+ xs = max(xp0, xp1) - xo + 1
+ ys = max(yp0, yp1) - yo + 1
+ print *, "Origin:", xo, yo, " Size:", xs, ys
+ ipick = hl_gtk_file_chooser_show(files, &
+ & filter=["image/png"], initial_file="cairo1.png"//c_null_char, &
+ & current=TRUE)
+ if (c_f_logical(ipick)) then
+ pixb = hl_gtk_drawing_area_get_gdk_pixbuf(widget, &
+ & x0 = xo, y0=yo, xsize=xs, ysize=ys)
+ call hl_gdk_pixbuf_save(pixb, trim(files(1)))
+ end if
+ end if
+ rflag = .false.
+ else
+ print *, "Button press detected"
print *, "Clicked at:", int(bevent%x), int(bevent%y)
print *, "Type:", bevent%type
print *, "State, Button:", bevent%state, bevent%button
print *, "Root x,y:", int(bevent%x_root), int(bevent%y_root)
dcname = gdk_device_get_name(bevent%device)
call c_f_string(dcname, dname)
- print *, "Device: ",trim(dname), &
+ print *, "Device: ",trim(dname), &
& gdk_device_get_source(bevent%device)
-
+
if (bevent%type == GDK_2BUTTON_PRESS .and. &
& bevent%button == 3) call gtk_main_quit
+
+ if (bevent%type == GDK_BUTTON_PRESS .and. &
+ & bevent%button == 1 .and. bevent%state == GDK_CONTROL_MASK) then
+ xp0 = nint(bevent%x)
+ yp0 = nint(bevent%y)
+ rflag = .true.
+ print *, "Begin region define"
+ end if
end if
print *
rv = FALSE
@@ -220,12 +257,12 @@ subroutine draw_pattern(widget)
& 0.5_c_double)
call cairo_set_line_width(my_cairo_context, 2._c_double)
do t = 0, int(height), +20
- call cairo_move_to(my_cairo_context, 0._c_double, real(t, c_double))
- call cairo_line_to(my_cairo_context, real(t, c_double), &
- & real(height, c_double))
- call cairo_stroke(my_cairo_context)
+ call cairo_move_to(my_cairo_context, 0._c_double, real(t, c_double))
+ call cairo_line_to(my_cairo_context, real(t, c_double), &
+ & real(height, c_double))
+ call cairo_stroke(my_cairo_context)
end do
-
+
! Text:
call cairo_set_source_rgb(my_cairo_context, 0._c_double, 0._c_double, &
& 1._c_double)
@@ -240,20 +277,20 @@ subroutine draw_pattern(widget)
! Circles:
call cairo_new_sub_path(my_cairo_context)
do t = 1, 50
- call cairo_set_source_rgb(my_cairo_context, t/50._c_double, &
- & 0._c_double, 0._c_double)
- call cairo_set_line_width(my_cairo_context, 5._c_double*t/50._c_double)
- call cairo_arc(my_cairo_context, 353._c_double+ &
- & 200._c_double*cos(t*2_c_double*pi/50), &
- & 350._c_double+200._c_double*sin(t*2._c_double*pi/50.), &
- & 50._c_double, 0._c_double, 2.*pi)
- call cairo_stroke(my_cairo_context)
+ call cairo_set_source_rgb(my_cairo_context, t/50._c_double, &
+ & 0._c_double, 0._c_double)
+ call cairo_set_line_width(my_cairo_context, 5._c_double*t/50._c_double)
+ call cairo_arc(my_cairo_context, 353._c_double+ &
+ & 200._c_double*cos(t*2_c_double*pi/50), &
+ & 350._c_double+200._c_double*sin(t*2._c_double*pi/50.), &
+ & 50._c_double, 0._c_double, 2.*pi)
+ call cairo_stroke(my_cairo_context)
end do
-
+
! Save:
cstatus = cairo_surface_write_to_png(cairo_get_target(my_cairo_context), &
& "cairo.png"//c_null_char)
-
+
call gtk_widget_queue_draw(widget)
call hl_gtk_drawing_area_cairo_destroy(my_cairo_context)
end subroutine draw_pattern
@@ -282,6 +319,7 @@ program cairo_basics_click
& size = (/width, height /), &
& ssize = (/ 400_c_int, 300_c_int /), &
& button_press_event=c_funloc(button_event_h), &
+ & button_release_event=c_funloc(button_event_h), &
& scroll_event=c_funloc(scroll_event_h), &
& enter_event=c_funloc(cross_event_h), &
& leave_event=c_funloc(cross_event_h), &
@@ -75,7 +75,6 @@ subroutine show_time(area, dat)
type(c_ptr), intent(in) :: area
integer, intent(in), dimension(:) :: dat
- type(cairo_user_data_key_t) :: key
type(c_ptr) :: cr, pixbuf
character(len=3) :: sdate
@@ -59,7 +59,6 @@ module plplot_code_ex17
real(kind=plflt) :: y1, y2, y3, y4, ymin, ymax, xlab, ylab
real(kind=plflt) :: t, tmin, tmax, tjump, dt, noise
- type(cairo_user_data_key_t) :: key
type(c_ptr) :: cc
integer :: colbox, collab, colline(4), styline(4)
character(len=20) :: legline(4)
Oops, something went wrong.

0 comments on commit aa5ed68

Please sign in to comment.