Some chatterbox discussion prompted me to post this gtk2-perl meter, which uses Tie::Watch to watch a scalar. This code is not perfected yet, it gives an error when exiting, and I can't find a way to mask the bottom of the circle....but it illustrates Tie::Watch use.....which is interesting, because it only responds to assignment.....not increment nor decrement. The error-on-exit only occurs if I update the text widget, in the update_meter sub.

If anyone knows how to fix the above problems, let me know. :-)

UPDATE: Thanks to muppet on the gtk2-perl maillist, there is a way to prevent the warnings. Code below fixed.

UPDATE2: Figured out how to clip the gauge, just put the canvas in a box...doh!!

#!/usr/bin/perl use warnings; use strict; use Glib qw/TRUE FALSE/; use Gtk2 '-init'; use Gnome2::Canvas; use constant PI => 3.1415926; use Tie::Watch; my $width = 200; my $height = 100; my $value = 0; my $max = 100; my $min = 0; my $watch = Tie::Watch->new( -variable => \$value, -shadow => 0, -store => \&update_meter, ); my $window = Gtk2::Window->new; $window->signal_connect( 'destroy' => \&delete_event ); $window->set_default_size( $width, $height ); my $canvas = Gnome2::Canvas->new_aa(); $canvas->set_size_request($width,$height); $canvas->set_scroll_region( 0, 0, $width, $height ); #to get upper l +eft corner $canvas->set_size_request( $width, $height ); #useless ? my $vbox = Gtk2::VBox->new( FALSE, 6 ); $window->add($vbox); $vbox->set_border_width(2); $vbox->pack_start($canvas,FALSE,FALSE,0); $window->show_all; my $root = $canvas->root(); my $text = Gnome2::Canvas::Item->new( $root, 'Gnome2::Canvas::Text', x => $width / 2, y => $height * .50, fill_color => 'yellow', font => 'Sans 14', anchor => 'GTK_ANCHOR_CENTER', text => $value ); my $box = Gnome2::Canvas::Item->new( $root, 'Gnome2::Canvas::Rect', x1 => 0, y1 => 0, x2 => $width, y2 => $height, fill_color => 'black', outline_color => 'black' ); my $hub = Gnome2::Canvas::Item->new( $root, "Gnome2::Canvas::Ellipse", x1 => $width / 2 - 8, y1 => ( $height * .80 ) - 8, x2 => $width / 2 + 8, y2 => ( $height * .80 ) + 8, fill_color => 'white', outline_color => 'black' ); my $gauge = Gnome2::Canvas::Item->new( $root, "Gnome2::Canvas::Ellipse", x1 => $width / 2 - 80, y1 => ( $height * .80 ) - 80, x2 => $width / 2 + 80, y2 => ( $height * .80 ) + 80, outline_color => 'white', fill_color => 'steelblue' ); my $floor = Gnome2::Canvas::Item->new( $root, 'Gnome2::Canvas::Rect', x1 => 0, y1 => $height * .80, x2 => $width, y2 => $height, fill_color => 'black', ); my $needle = Gnome2::Canvas::Item->new( $root, "Gnome2::Canvas::Line", points => [ $width / 2, ( $height * .80 ), $width / 2, 10 ], width_units => 5, fill_color => 'hotpink', last_arrowhead => 1, arrow_shape_b => 20 ); $box->lower_to_bottom; $needle->raise_to_top; $hub->raise_to_top; $text->raise($gauge); my $toggle = 1; my $count = 0; Glib::Timeout->add (50, sub { $count += $toggle; $value = $count; return TRUE; } ); Gtk2->main; ###########################################################3 sub delete_event { #muppet's fixes for errors on exit $text = undef; $box = undef; $hub = undef; $gauge = undef; $floor = undef; $needle = undef; # end update fixes $watch->Unwatch; $canvas->destroy; Gtk2->main_quit; return 0; } ###########################################################3 sub update_meter { if ( $value <= $min ) { $toggle = 1 } if ( $value >= $max ) { $toggle = -1 } my $pos = $value * PI/$max; my $x = $width/2 - $height * .80 * ( cos( $pos ) ); my $y = $height * .80 - $height * .80 * ( sin( $pos ) ) ; $needle->set( points => [ $width / 2, ( $height * .80 ), $x, $y ], +); $text->set(text => $value); return $value; } ############################################################

Replies are listed 'Best First'.
Re: Gtk2-perl simple meter
by zentara (Cardinal) on Jul 13, 2005 at 17:54 UTC
    Well I alrady made 2 updates to this script to get it going. But I have even More!!!..... hacking the details in gtk2-perl. Anyways Grant McLean on the gtk2-perl maillist pointed out that I could avoid the error message, by changing my 'destroy' signal connect, to a 'delete_event' signal connect, and I wouldn't need all those 'undef' statements, but a 1 must be returned from the sub.

    Gtk2-perl offers alot more control than Tk, but you must pay for it in attention to details. As a bonus, Grant also showed a different way to clip the circle, by setting up a PathDef to clip the Ellipse. I must admit, it is beautiful, but considerably less-intuitive than Tk. Here is Grant's version of the meter->Simple-meter-with-bezier


    I'm not really a human, but I play one on earth. flash japh